自定义Ribbon可用但需调优：跨平台VBA脚本报错求助

问题背景 #

通过Python启动Excel时会破坏自定义Ribbon，现有VBA代码可解决该问题，但存在全局IRibbonUI对象状态丢失的情况，同时出现以下异常：

• Excel VBA编辑器中第9行代码显示红色标记（语法/类型错误）
• Win10 x64的LibreOffice x64套件中运行时提示“BASIC语法错误。过程内不允许使用函数”
• 在线编译器中运行出现多类错误

需要调整代码以适配Win x64/x86平台及不同Office版本，确保个人重要项目稳定运行。

错误原因分析 #

1. VBA编辑器第9行红标：原代码中VBA7（64位Office）分支的CopyMemory函数length参数使用Long类型，与PtrSafe声明的64位指针长度不匹配，导致类型错误。
2. LibreOffice报错：代码依赖Excel专属的IRibbonUI对象模型及VBA条件编译指令，LibreOffice Basic不支持这些特性，因此无法兼容。
3. 在线编译器报错：在线环境缺乏Office对象模型支持，且无法调用Windows系统API，这类代码仅能在本地Excel环境运行。

修复后的VBA代码 #

Option Explicit

Public YourRibbon As IRibbonUI
Public ABCDEFG As String
Public ITTA As String ' 声明全局变量，避免Option Explicit报错

#If VBA7 Then
' 修正64位环境下参数类型：length改为LongPtr，匹配PtrSafe指针长度
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As LongPtr)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#End If

Public Sub RibbonOnLoad(ribbon As IRibbonUI)
   ' 存储IRibbonUI指针到全局变量和工作表单元格
    Set YourRibbon = ribbon
    ' 使用ThisWorkbook避免工作表重命名导致失效
    ThisWorkbook.Sheets(1).Range("A1").Value = ObjPtr(ribbon)
End Sub

#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
    Dim objRibbon As Object
    CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
    Set GetRibbon = objRibbon
    Set objRibbon = Nothing
End Function

Sub GetVisible(control As IRibbonControl, ByRef visible)
    If ITTA = "show" Then
        visible = True
    Else
        ' 增加空值判断，避免未赋值时Like运算报错
        If Len(ABCDEFG) > 0 And control.Tag Like ABCDEFG Then
            visible = True
        Else
            visible = False
        End If
    End If
End Sub

Sub RefreshRibbon(Tag As String)
    ITTA = Tag
    If YourRibbon Is Nothing Then
        ' 从工作表恢复IRibbonUI对象
        Set YourRibbon = GetRibbon(ThisWorkbook.Sheets(1).Range("A1").Value)
    End If
    ' 确保对象有效再执行Invalidate
    If Not YourRibbon Is Nothing Then
        YourRibbon.Invalidate
    End If
End Sub

'**********************************************************************************
' 示例：通过GetVisible控制Ribbon元素显示状态
'**********************************************************************************

Sub DisplayRibbonTab()
' 仅显示标签为"ITTA"的Tab/Group/Control
    Call RefreshRibbon(Tag:="ITTA")
End Sub

'Sub DisplayRibbonTab_2()
' 显示所有标签以"My"开头的Ribbon元素
    'Call RefreshRibbon(Tag:="My*")
'End Sub

'Sub DisplayRibbonTab_3()
' 显示所有Ribbon元素（使用通配符"*"）
    'Call RefreshRibbon(Tag:="*")
'End Sub

'Note: 当前示例宏默认显示自定义Tab，添加更多自定义Tab后需调整逻辑

'Sub HideEveryTab()
' 隐藏所有Ribbon元素（传入空Tag）
    'Call RefreshRibbon(Tag:="")
'End Sub

修复要点说明 #

• 类型匹配修正：调整64位环境下CopyMemory的length参数为LongPtr，解决VBA编辑器红标问题。
• 变量声明规范：新增ITTA全局变量声明，符合Option Explicit要求，避免运行时错误。
• 鲁棒性优化：增加空值判断、优化工作表引用，避免因工作表重命名、变量未赋值导致的异常。
• 兼容性说明：代码仅适配Excel环境，无法在LibreOffice中运行；需在本地Excel环境执行，在线编译器不支持相关依赖。

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