Ist es möglich, mehrere Instanzen desselben Subs auszuführen, oder ist ein Refactoring erforderlich?

Question

Erwartetes Ergebnis

Das Entfernen Anspruch obigen Schalter sind inkompatibel mit dem HL Segment Numbering-Schalter. Wenn der Benutzer den HL-Segmentnummerierungsschalter einschaltet, während einer oder beide Schalter zum Entfernen von Ansprüchen bereits eingeschaltet sind, werden die Schalter zum Entfernen von Ansprüchen deaktiviert und umgekehrt.

---

Ich versuche, effizient eine verwenden Sub, Toggle_Click, Drehschalter ein- und ausschalten zu verwalten, und eine andere, Toggle_ErrorPrevention, davor zugleich eingeschaltet zwei inkompatible Schalter zu verhindern.

Das Problem, das ich Probleme mit habe, ist, dass, wenn Toggle_ErrorPrevention durch einen inkompatiblen Schalter auszuschalten versucht Toggle_Click über Application.Run .Shapes([incompatible switch]).OnAction Aufruf, Toggle_Click nicht die inkompatible Schalter als neue Application.Caller erkennen, zu glauben, es anstelle der Original-Schalter sein, dass begann die ganze Sequenz.

Dies liegt möglicherweise daran, dass Toggle_Click sich immer noch mitten in der Ausführung ab dem ersten Anruf befindet und VBA einen neuen Anrufer erst nach dem ersten Anruf erkennen kann.

Wie kann ich Toggle_Click erhalten, um [inkompatiblen Schalter] als eine neue Application.Caller zu erkennen?

Option Explicit 

Sub Toggle_Click() 
    Dim lngMoveBy As Long 
    Dim Loop1 As Long 
    Dim intShapeNumber As Integer 
    Dim boolActive As Boolean 

    '--- A user clicked a toggle or Toggle_ErrPrevention is trying to turn off an incompatible toggle --- 
    'Which toggle triggered this sub? Get ready to turn that toggle on/off 
    intShapeNumber = Right(Application.Caller, Len(Application.Caller) - Len("Toggle")) 
    'Is the toggle inactive (white)? 
    If ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber).Fill.ForeColor.RGB = RGB(255, 255, 255) Then boolActive = False Else boolActive = True 
    'A user-clicked toggle that is currently off may have incompatible toggles that are currently on. If currently off, prevent errors 
    'If Toggle_ErrPrevention is trying to turn off an incompatible toggle, it won't trigger itself again because incompatible toggles are always on 
    If boolActive = False Then Toggle_ErrorPrevention intShapeNumber 

    '--- The triggering toggle was on or all incompatible toggles have been turned off. Get ready to change triggering toggle state --- 
    'Which direction should the switch graphic be moved? 
    If boolActive = False Then 
     'Move right to On position 
     lngMoveBy = 0.6 
    Else 
     'Move left to Off position 
     lngMoveBy = -0.6 
    End If 

    'Actually move the switch graphic in the appropriate direction 
    With ThisWorkbook.Sheets("Correction Type Options").Shapes("Toggle" & intShapeNumber) 
     For Loop1 = 1 To 24 
      .IncrementLeft lngMoveBy 
      DoEvents 
     Next Loop1 
    End With 

    'Change switch text and color 
    If boolActive = False Then 
     With ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber) 
      .Fill.ForeColor.RGB = RGB(0, 255, 0) 
      .TextFrame.Characters.Text = "On" 
      .TextFrame.Characters.Font.Bold = True 
      .TextFrame.Characters.Font.ColorIndex = 1 
      .TextFrame.HorizontalAlignment = xlLeft 
      .TextFrame.VerticalAlignment = xlCenter 
     End With 
    Else 
     With ThisWorkbook.Sheets("Correction Type Options").Shapes("ToggleBackground" & intShapeNumber) 
      .Fill.ForeColor.RGB = RGB(255, 255, 255) 
      .TextFrame.Characters.Text = "Off" 
      .TextFrame.Characters.Font.Bold = True 
      .TextFrame.Characters.Font.ColorIndex = 1 
      .TextFrame.HorizontalAlignment = xlRight 
      .TextFrame.VerticalAlignment = xlCenter 
     End With 
    End If 

End Sub 

Sub Toggle_ErrorPrevention(ByVal intShapeNumberVal As Integer) 

    Dim lngHLSegmentNumberingRow As Long 
    Dim lngClaimRemovalHaveWantedClaimsRow As Long 
    Dim lngClaimRemovalHaveUnwantedClaimsRow As Long 


    'Find current location of incompatible switches 
    With ThisWorkbook.Sheets("Correction Type Options").Columns(1) 
     lngHLSegmentNumberingRow = .Find(What:="HL Segment Numbering", Lookat:=xlWhole).Row 
     lngClaimRemovalHaveWantedClaimsRow = .Find(What:="Claim Removal - Have Wanted Claims", Lookat:=xlWhole).Row 
     lngClaimRemovalHaveUnwantedClaimsRow = .Find(What:="Claim Removal - Have Unwanted Claims", Lookat:=xlWhole).Row 
    End With 

    'If an incompatible switch is green (on), run Toggle_Click for the incompatible switch 
    With ThisWorkbook.Sheets("Correction Type Options") 
     'Claim Removal is incompatible with HL Segment Numbering 
     If intShapeNumberVal + 1 = lngHLSegmentNumberingRow Then 
      If .Shapes("ToggleBackground" & lngClaimRemovalHaveWantedClaimsRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngClaimRemovalHaveWantedClaimsRow - 1).OnAction 
      If .Shapes("ToggleBackground" & lngClaimRemovalHaveUnwantedClaimsRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngClaimRemovalHaveUnwantedClaimsRow - 1).OnAction 
     End If 
     'HL Segment Numbering is incompatible with Claim Removal 
     If intShapeNumberVal + 1 = lngClaimRemovalHaveWantedClaimsRow Or intShapeNumberVal + 1 = lngClaimRemovalHaveUnwantedClaimsRow Then 
      If .Shapes("ToggleBackground" & lngHLSegmentNumberingRow - 1).Fill.ForeColor.RGB = RGB(0, 255, 0) Then Application.Run .Shapes("Toggle" & lngHLSegmentNumberingRow - 1).OnAction 
     End If 
    End With 

End Sub 

Answer 1

Der folgende Code schaltet Ihre drei Formen wie folgt aus:

Option Explicit 

Sub ToggleShape() 
    With ThisWorkbook.Worksheets("Sheet1") 
     Dim selectedShape As Shape 
     Set selectedShape = .Shapes(Application.Caller) 

     'always turn on selected shape 
     FormatShape selectedShape, "On" 

     'turn off relevant other shapes 
     Select Case selectedShape.Name 
      Case "ToggleBackground1" 
       FormatShape .Shapes("ToggleBackground2"), "Off" 
       FormatShape .Shapes("ToggleBackground3"), "Off" 
      Case Else 
       FormatShape .Shapes("ToggleBackground1"), "Off" 
     End Select 
    End With 
End Sub 

Sub FormatShape(sh As Shape, status As String) 
    With sh 
     If status = "On" Then 
      .Fill.ForeColor.RGB = RGB(0, 255, 0) 
      .TextFrame.Characters.Text = "On" 
     Else 
      .Fill.ForeColor.RGB = RGB(255, 255, 255) 
      .TextFrame.Characters.Text = "Off" 
     End If 
    End With 
End Sub