Excel VBA：编程实现自定义ToggleButton仅保留单个选中状态

需求与问题 #

使用Office Ribbon X Editor为Excel创建了含多个toggleButton的自定义功能区，要求同一时刻仅允许一个toggleButton处于选中状态。但实际运行时，点击新按钮后旧按钮不会自动取消选中；仅在调试时给AnyButtonGotPressed的Select Case设置断点，代码才能正常工作。

现有自定义功能区XML代码 #

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="OnRibbonLoad">
    <ribbon>
        <tabs>
            <tab id="customTab" label="MyRibbon" insertAfterMso="TabHome">
                <group id="customGroup1" label="MyButtons">
                    <toggleButton id="customButton1" label="Label1" getPressed="GetPressed" onAction="AnyButtonGotPressed"/>
                    <toggleButton id="customButton2" label="Label2" getPressed="GetPressed" onAction="AnyButtonGotPressed"/>
                    <toggleButton id="customButton3" label="Label3" getPressed="GetPressed" onAction="AnyButtonGotPressed"/>
                    <!-- 更多toggleButton -->
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

现有VBA代码 #

Option Explicit

Public myRibbon As IRibbonUI
Public pressed As Boolean
----------------------------------------------------------------------------------

Sub OnRibbonLoad(ribbon As IRibbonUI)
    Set myRibbon = ribbon
End Sub
----------------------------------------------------------------------------------

Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
    '未实现逻辑，无法正确更新按钮选中状态
End Sub
----------------------------------------------------------------------------------

Sub AnyButtonGotPressed(control As IRibbonControl, IsPressed)
Dim arrButtons As Variant
Dim varButton As Variant

    arrButtons = Array("customButton1", "customButton2", "customButton3")

    For Each varButton In arrButtons
        If Not varButton = control.ID Then myRibbon.InvalidateControl varButton
    Next

    pressed = IsPressed

    Select Case control.ID
        Case "customButton1"
            Call FirstMacro(control.ID)
        Case "customButton2"        
            Call SecondMacro(control.ID)
         Case "customButton3"        
            Call ThirdMacro(control.ID)
    End Select
End Sub
----------------------------------------------------------------------------------

Sub FirstMacro(ButtonName As String)
    If Not pressed Then GoTo ErrorHandler
    On Error GoTo ErrorHandler
       
    With ThisWorkbook.Sheets(1)
Continue:
        .Range("A1").Select
                
        Do While Selection.Address = "$A$1"
            DoEvents           
            If Not pressed Then GoTo ErrorHandler
        Loop

        '处理选中单元格的逻辑

        If pressed Then GoTo Continue
    End With

ErrorHandler:
    myRibbon.InvalidateControl ButtonName
End Sub

问题根源 #

1. GetPressed函数未实现：Ribbon依赖该函数判断每个toggleButton是否应该显示为选中状态，空实现导致控件状态无法正确更新。
2. UI线程阻塞：宏中的Do While循环持续占用线程，无断点时Ribbon没有机会完成重绘；断点时线程暂停，UI得以更新。
3. 控件失效方式低效：循环逐个失效控件的方式不如直接失效整个控件组，且未同步更新状态标记。

最简解决方案 #

步骤1：添加全局状态变量 #

新增全局变量跟踪当前选中的按钮ID，替代原有的单一pressed变量（pressed可保留用于宏内状态判断）：

Public myRibbon As IRibbonUI
Public pressed As Boolean
Public currentPressedButton As String '记录当前选中的按钮ID

步骤2：实现GetPressed函数 #

让Ribbon能根据全局变量判断按钮是否选中：

Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
    '如果当前控件ID等于记录的选中ID，返回True（选中），否则返回False
    returnedVal = (control.ID = currentPressedButton)
End Sub

步骤3：优化AnyButtonGotPressed逻辑 #

• 点击按钮时，更新全局选中状态
• 直接失效整个控件组（无需循环逐个处理，适合扩展到14+按钮）

Sub AnyButtonGotPressed(control As IRibbonControl, IsPressed)
    pressed = IsPressed
    
    If IsPressed Then
        '按下按钮时，更新当前选中ID
        currentPressedButton = control.ID
    Else
        '抬起按钮时，清空选中ID
        currentPressedButton = ""
    End If
    
    '失效整个控件组，触发所有toggleButton调用GetPressed更新状态
    myRibbon.InvalidateControlGroup "customGroup1"

    Select Case control.ID
        Case "customButton1"
            Call FirstMacro(control.ID)
        Case "customButton2"        
            Call SecondMacro(control.ID)
         Case "customButton3"        
            Call ThirdMacro(control.ID)
    End Select
End Sub

步骤4：调整宏内逻辑（可选优化） #

确保宏运行时，切换按钮能及时终止当前循环：

Sub FirstMacro(ButtonName As String)
    If Not pressed Then GoTo ErrorHandler
    On Error GoTo ErrorHandler
       
    With ThisWorkbook.Sheets(1)
Continue:
        '避免强制选中A1，允许用户自由选择单元格
        If Selection.Address = "$A$1" Then
            DoEvents
            '如果当前选中按钮已变更，直接退出
            If currentPressedButton <> ButtonName Then GoTo ErrorHandler
            If Not pressed Then GoTo ErrorHandler
            GoTo Continue
        End If

        '处理选中单元格的逻辑

        '如果当前按钮仍处于选中状态，继续监听
        If pressed And currentPressedButton = ButtonName Then GoTo Continue
    End With

ErrorHandler:
    '如果是主动退出，无需失效控件（已由AnyButtonGotPressed处理）
    '仅在异常时失效
    If Err.Number <> 0 Then
        myRibbon.InvalidateControl ButtonName
    End If
End Sub

效果验证 #

修改后，点击任意toggleButton时：

1. 之前选中的按钮会自动取消选中状态
2. 宏运行时切换按钮，当前宏会及时终止并更新Ribbon状态
3. 扩展到14+按钮时，仅需在XML中添加新按钮，无需修改VBA的循环逻辑

内容的提问来源于stack exchange，提问作者LuPi1801