Question

预期结果

上述声明删除开关与HL段编号开关不兼容。如果用户在一个或两个声明移除开关已经打开时打开HL段编号开关，则声明移除开关将关闭，反之亦然。

我正在尝试有效地使用一个Sub，Toggle_Click来管理打开和关闭开关，另一个Toggle_ErrorPrevention，以防止两个不兼容的开关被打开同一时间。

我遇到问题的问题是当Toggle_ErrorPrevention尝试通过Toggle_Click调用Application.Run .Shapes([incompatible switch]).OnAction来关闭不兼容的切换时，Toggle_Click无法识别不兼容的切换为新的Application.Caller，相信它是启动整个序列的原始开关。

这可能是因为Toggle_Click仍然是第一次呼叫的执行中期，并且VBA在第一次呼叫结束之前无法识别新的呼叫者。

如何让Toggle_Click将[不兼容的开关]识别为新的Application.Caller？

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

下面的代码切换你的三个形状：

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

是否可以运行同一个子的多个实例，或者是否需要重构？

1 个答案: