excel 自定义功能区工作正常,但需要进行一些调整

5lhxktic  于 2023-01-18  发布在  其他
关注(0)|答案(1)|浏览(176)

我遇到了一个问题,从Python启动Excel会损坏自定义功能区。
我最终得到了完成这项工作的代码。从Python启动Excel不再会破坏自定义功能区。带有丢失全局IRibbonUI功能区对象状态的补充这是几年前写的。
这段代码在我的机器上运行得很好。对于自己的使用来说非常有用和稳定,但是我看到了一些奇怪的事情。
我只想说我对VBA脚本一无所知,也不理解其中的错误。我知道IT领域的其他东西,但不知道代码。因此我来到这里。
我遇到的错误:在Excel VBA编辑器中,第9行文本显示为红色(我不知道为什么..)
在Win10 x64上运行Libre-Office x64套件中的代码,我会收到错误“BASIC语法错误。过程中不允许使用函数。”(我也不知道为什么。)
当在在线编译器中运行代码时,甚至会出现更多的错误。(现在我更不知道了。)
我必须让这个VBA脚本为我正在进行的个人项目工作,这对我来说真的很重要。这个VBA脚本必须能够在Win x64和x86平台以及各种Office版本上运行。
所有需要的是一些调整/调整几行。我问漂亮请如果有人能帮我排序的错误。
先谢谢你。非常感谢。

Option Explicit

Public YourRibbon As IRibbonUI
Public ABCDEFG As String

#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#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)
   ' Store pointer to IRibbonUI
    Set YourRibbon = ribbon
    Sheet1.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
        If 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
        Set YourRibbon = GetRibbon(Sheets(1).Range("A1").Value)
        YourRibbon.Invalidate
        'MsgBox "The Ribbon handle was lost, Hopefully this is sorted now by the GetRibbon Function?. You can remove this msgbox, I only use it for testing"
    Else
        YourRibbon.Invalidate
    End If
End Sub

'**********************************************************************************
'Examples to show only the Tab with the tag you want with getVisible in the RibbonX.
'**********************************************************************************

Sub DisplayRibbonTab()
'Show only the Tab, Group or Control with the Tag "ITTA"
    Call RefreshRibbon(Tag:="ITTA")
End Sub

'Sub DisplayRibbonTab_2()
'Show every Tab, Group or Control with every Tag that start with "My"
    'Call RefreshRibbon(Tag:="My*")
'End Sub

'Sub DisplayRibbonTab_3()
'Show every Tab, Group or Control(we use the wildcard "*")
    'Call RefreshRibbon(Tag:="*")
'End Sub

'Note: in this example every macro above will show you the custom tab.
'If you add more custom tabs this will be different

'Sub HideEveryTab()
'Hide every Tab, Group or Control(we use Tag:="")
    'Call RefreshRibbon(Tag:="")
'End Sub
pkmbmrz7

pkmbmrz71#

首先,功能区自定义UI无需使用Windows API函数:

#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#End If

其次,不需要返回指向Ribbon UI示例的指针:

#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

你所需要的只是一个Ribbon XML,它定义了控件的结构,并在代码中定义了回调函数。Fluent UI(又名Ribbon UI)将在以下系列文章中进行深入描述:

相关问题