Production et contrôle VBA pour Flashy, Blinky, Shifty, Actif, Range-Selection-Border

Question

L'application que je programme pourrait bénéficier d'une bordure, comme celles qui sont induites lors du choix d'une gamme. Je ne connais pas le nom Microsoft officiel pour le type de bordure, mais il ressemble à des tirets flashy, blinky, shifty. Cela aiderait l'utilisateur à savoir (ou se souvenir après avoir été interrompu par un collègue) de la gamme de cellules avec laquelle il est censé travailler. Je serais gêné d'admettre combien de temps je pense que j'ai passé à chercher et à essayer de produire cette frontière. Il comprend toute la journée, hier et 3 ou 4 autres essais ciblés. Un qui semblait produire un résultat raisonnable avec de petites sélections de gamme est comme suit - mais encore une fois, seulement de petites sélections et cela oblige excel à devoir "penser" pendant un moment après l'exécution, avant d'abandonner le contrôle à l'utilisateur:

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 

Les éléments suivants semblaient fournir un délai de temps plus stable:

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

Mais, lorsque je tente de le mettre en œuvre avec un gestionnaire:

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 

Je ne suis pas encore capable de produire le comportement souhaité pour intégrer mon programme. Je veux que mon code normal soit capable de faire des choses pendant que le manipulateur produit la bordure flashy, blinky, shifty. Par exemple, le code que j'essayé d'utiliser pour vérifier son comportement est:

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 

Je ne suis pas très expérimenté au codage des gestionnaires. Je suis passé à peu près 15 ans sans codage dans aucune langue et les gestionnaires ont été un point faible pour moi. Mais, j'ai fait beaucoup de progrès avec un petit projet ambitieux. Je veux être en mesure de contrôler la frontière flashy, blinky, shifty pour une utilisation dans le programme. Quelqu'un veut-il partager comment ils produisent ce style de bordure dans leur code? Est-ce possible en VBA? Je vous remercie.

Answer 1

Si vous voulez en boucle, le code serait comme ce 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