VBA为Flashy，Blicky，Shifty，活动，范围选择边框生成和控制

我正在编程的应用程序可以从边框中获益，就像选择范围时引发的那样。我不知道边界类型的官方微软名称，但它看起来像华而不实，闪烁，狡猾的破折号。这将有助于用户知道（或者在被同事中断后记得）他们应该使用的单元范围。我会不好意思承认我花了多少时间研究并尝试制作这个边界。它包括全天，昨天以及其他3或4次其他重点试验。VBA为Flashy，Blicky，Shifty，活动，范围选择边框生成和控制

一个似乎用小范围选择产生合理结果的方法如下 - 但是再次，只有小的选择，并且它导致excel必须在执行之后“思考”一段时间，然后才向用户交出控制权：

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 

Sub test() 
    Dim i_index As Long 
    Dim Selec As Range 

    Set Selec = Application.InputBox("Select a range to make a flashy, blinky border.", _ 
           "Select Range", _ 
           Type:=8) 

    For i_index = 1 To 50 

     If Selec.Borders.LineStyle = xlLineStyleNone Or Selec.Borders.LineStyle = xlDashDot Then 
      With Selec 
       .Borders(xlEdgeLeft).LineStyle = xlDashDotDot 
       .Borders(xlEdgeRight).LineStyle = xlDashDotDot 
       .Borders(xlEdgeBottom).LineStyle = xlDashDotDot 
       .Borders(xlEdgeTop).LineStyle = xlDashDotDot 
      End With 
     ElseIf Selec.Borders.LineStyle = xlDashDotDot Then 
      With Selec 
       .Borders(xlEdgeLeft).LineStyle = xlDashDot 
       .Borders(xlEdgeRight).LineStyle = xlDashDot 
       .Borders(xlEdgeBottom).LineStyle = xlDashDot 
       .Borders(xlEdgeTop).LineStyle = xlDashDot 
      End With 
     End If 

     Sleep 500 'wait 0.5 seconds 

    Next i_index 
End Sub

下似乎提供了更稳定的时间延迟：

Sub SD(LenTime) 
    Dim Start 
    Start = Timer + LenTime 
    Do While Timer < Start 
     If Timer = 0 Then 
      Start = Timer + 1 
     End If 
    Loop 
End Sub

但是，当我尝试用一个处理器来实现它：

Public Sub CodeInst_StartFlashyBorder(ByVal Selection As Range) 
    Call StartFlashyBorder(Selection) 
End Sub 

Public Sub CodeInst_StopFlashyBorder(ByVal Selection As Range) 
    Call StopFlashyBorder(Selection) 
End Sub 

Private Sub StartFlashyBorder(ByVal Target As Range) 

    If Target.Borders.LineStyle = xlLineStyleNone Or Target.Borders.LineStyle _ 
     = xlDashDot Then 
     With Target 
      .Borders(xlEdgeLeft).LineStyle = xlDashDotDot 
      .Borders(xlEdgeRight).LineStyle = xlDashDotDot 
      .Borders(xlEdgeBottom).LineStyle = xlDashDotDot 
      .Borders(xlEdgeTop).LineStyle = xlDashDotDot 
     End With 
    ElseIf Target.Borders.LineStyle = xlDashDotDot Then 
     With Target 
      .Borders(xlEdgeLeft).LineStyle = xlDashDot 
      .Borders(xlEdgeRight).LineStyle = xlDashDot 
      .Borders(xlEdgeBottom).LineStyle = xlDashDot 
      .Borders(xlEdgeTop).LineStyle = xlDashDot 
     End With 
    End If 

    SD 0.25 

    Application.OnTime Now, "StartFlashyBorder", , True 

End Sub 

Private Sub StopFlashyBorder(ByVal Target As Range) 
    Target.Borders.LineStyle = xlLineStyleNone 
    Application.OnTime Now, "StartFlashyBorder", , False 
End Sub

到目前为止，我无法产生想要的行为来融入我的程序。我希望我的常规代码能够在处理程序生成华而不实的闪烁边界时执行某些操作。例如，我试图用来检查其行为的代码是：

Sub TestBorder() 

    Dim r1 As Range 
    Dim r2 As Range 
    Dim r3 As Range 

    Set r1 = Application.InputBox("Select cell-range #1 and click OK.", _ 
            "Make Selection", _ 
            Type:=8) 

    Call CodeInst_StartFlashyBorder(r1) 

    Set r2 = Application.InputBox("Select cell-range #2 and click OK.", _ 
            "Make Selection", _ 
            Type:=8) 

    Call CodeInst_StartFlashyBorder(r1) 

    Set r3 = Application.InputBox("Select cell-range #3 and click OK.", _ 
            "Make Selection", _ 
            Type:=8) 

    Call CodeInst_StartFlashyBorder(r1) 

    If Application.InputBox("Enter 0 to turn off cell-range #1.", _ 
          "Enter Choice", _ 
          Type:=1) = 0 Then 
     Call CodeInst_StopFlashyBorder(r1) 
    End If 

    If Application.InputBox("Enter 0 to turn off cell-range #2.", _ 
          "Enter Choice", _ 
          Type:=1) = 0 Then 
     Call CodeInst_StopFlashyBorder(r2) 
    End If 

    If Application.InputBox("Enter 0 to turn off cell-range #3.", _ 
          "Enter Choice", _ 
          Type:=1) = 0 Then 
     Call CodeInst_StopFlashyBorder(r3) 
    End If 

End Sub

我在编码处理程序方面经验不是很丰富。我差不多15年没有用任何语言编写代码，那时处理程序对我来说是一个弱点。但是，我通过一个雄心勃勃的小项目取得了很大进展。我希望能够控制程序中使用的华而不实的闪烁边界。有没有人关心如何在代码中生成这种边框样式？在VBA中可能吗？谢谢。

来源

2017-06-20 Ben

你是所谓的“行进中的蚂蚁”的复制后，你看到的边界，当你打“Ctrl + C”/复制？ –

“行军蚂蚁” - 是的，这个名字看起来很准确。我正在努力实现这个或者任何具有非常类似视觉效果的东西。 – Ben

如果你想循环，代码会是这样 Selec.Offset（i_index - 1）

Sub test() 
    Dim i_index As Long 
    Dim Selec As Range 

    Set Selec = Application.InputBox("Select a range to make a flashy, blinky border.", _ 
           "Select Range", _ 
           Type:=8) 

    For i_index = 1 To 50 
     With Selec.Offset(i_index - 1) 
      If .Borders.LineStyle = xlLineStyleNone Or .Borders.LineStyle = xlDashDot Then 

        .Borders(xlEdgeLeft).LineStyle = xlDashDotDot 
        .Borders(xlEdgeRight).LineStyle = xlDashDotDot 
        .Borders(xlEdgeBottom).LineStyle = xlDashDotDot 
        .Borders(xlEdgeTop).LineStyle = xlDashDotDot 

      ElseIf .Borders.LineStyle = xlDashDotDot Then 

        .Borders(xlEdgeLeft).LineStyle = xlDashDot 
        .Borders(xlEdgeRight).LineStyle = xlDashDot 
        .Borders(xlEdgeBottom).LineStyle = xlDashDot 
        .Borders(xlEdgeTop).LineStyle = xlDashDot 

      End If 
     End With 
     'Sleep 500 'wait 0.5 seconds 

    Next i_index 
End Sub

来源

2017-06-20 04:50:08

VBA为Flashy，Blicky，Shifty，活动，范围选择边框生成和控制

回答

相关问题