自定义Ribbon动态控件显示打开工作簿列表空白问题求助

你的动态Ribbon菜单为空，核心原因是代码存在几个关键错误，以下是具体问题和修正后的完整代码：

主要错误点 #

1. 缺失CreationAttribut函数：用于生成XML属性的核心函数未定义，导致生成的XML格式无效，Ribbon无法解析
2. 变量名冲突：Liste_WB函数的参数与循环变量重名，引发逻辑异常
3. 回调名称不匹配：onAction指定的ActivationWB与实际子过程名activateWB不一致
4. 工作簿激活逻辑错误：直接使用wb(control.Tag)无法正确引用工作簿
5. XML命名空间不一致：动态菜单内容使用的命名空间与主XML不统一

修正后的完整代码 #

1. XML代码（添加onLoad回调以支持动态更新） #

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="RibbonOnLoad">
    <ribbon>
        <tabs>
            <tab id="customTab" label="FecXtools" insertBeforeMso="TabHome">
                <group id="Navig" label="Navig">
                    <dynamicMenu id="ListeDynamiqueWb"
                        label="Liste Classeurs"
                        getContent="CreationMenuDynamiqueWb"
                        invalidateContentOnDrop="true"
                        size="normal"
                        imageMso="ChartShowData"/>
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

2. VBA代码（标准模块） #

Option Explicit

' 全局Ribbon对象，用于动态刷新菜单
Public ribbon As IRibbonUI

' Ribbon加载时的回调
Sub RibbonOnLoad(ribbonObj As IRibbonUI)
    Set ribbon = ribbonObj
End Sub

' 动态菜单内容生成回调
Public Sub CreationMenuDynamiqueWB(ctl As IRibbonControl, ByRef content)
    ' 使用与主XML一致的命名空间
    content = "<menu xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">"
    ' 添加工作簿列表
    content = content & Liste_WB()
    content = content & "</menu>"
End Sub

' 生成工作簿列表的XML字符串
Private Function Liste_WB() As String
    Dim strTemp As String
    Dim eachWB As Workbook ' 重命名循环变量避免冲突
    
    ' 添加菜单分隔符
    strTemp = "<menuSeparator id=""Classeurs"" title=""Classeurs""/>"

    ' 为每个打开的工作簿生成按钮
    For Each eachWB In Application.Workbooks
        strTemp = strTemp & _
          "<button " & _
          CreationAttribut("id", "Bt" & eachWB.Name) & " " & _
          CreationAttribut("label", eachWB.Name) & " " & _
          CreationAttribut("tag", eachWB.Name) & " " & _
          CreationAttribut("onAction", "ActivationWB") & "/>"
    Next
    Liste_WB = strTemp
End Function

' 生成XML属性的工具函数（缺失的核心函数）
Private Function CreationAttribut(attrName As String, attrValue As String) As String
    ' 转义值中的双引号
    Dim escapedValue As String
    escapedValue = Replace(attrValue, """", """""")
    CreationAttribut = attrName & "=""" & escapedValue & """"
End Function

' 工作簿激活回调
Sub ActivationWB(control As IRibbonControl)
    ' 处理工作簿已关闭的异常情况
    On Error Resume Next
    Application.Workbooks(control.Tag).Activate
    On Error GoTo 0
End Sub

3. 工作簿事件（ThisWorkbook模块） #

用于在工作簿打开/关闭时自动刷新菜单：

Private Sub Workbook_Open()
    If Not ribbon Is Nothing Then
        ribbon.InvalidateControl "ListeDynamiqueWb"
    End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Not ribbon Is Nothing Then
        ribbon.InvalidateControl "ListeDynamiqueWb"
    End If
End Sub

关键修复说明 #

• 添加CreationAttribut函数：正确生成带转义的XML属性，确保Ribbon能解析菜单内容
• 修复变量名冲突：将循环变量改为eachWB，避免覆盖函数参数
• 统一回调名称：将激活子过程命名为ActivationWB，与onAction指定的名称一致
• 修正激活逻辑：使用Application.Workbooks(control.Tag)正确通过名称引用工作簿
• 添加动态刷新：通过onLoad和工作簿事件实现菜单内容的实时更新

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