Custom Ribbon working but needs some tuning

171 Views Asked by At

I had a problem that starting Excel from Python whacks the Custom ribbon.

I eventually got code that does the job. Starting Excel from Python does not whack the Custom ribbon anymore. With complements of losing the state of the global IRibbonUI ribbon object This was written some years ago.

The code works well on my machine. Quite usable and stable for one's own use but I see some strange things.

Let me just say I know nothing of VBA script nor do I understand the errors. I know other things in the IT field but not code. Hence why I'm here.

Errors I get: In the Excel VBA editor line 9 text shows red (I dont know why..)

Running the Code in a Libre-Office x64 suite on Win10 x64 I get error "BASIC syntax error. Function not allowed within a procedure." (again I dont know why..)

Even more errors come up when running the code in an online compiler. (now I'm even more clueless..)

I have to get this VBA script to work for a personal project I'm working on which is really important to me. This VBA script must be able to run on Win x64 and x86 platforms and on various Office releases.

All that's needed is some tweaking/tuning a few lines. I'm asking pretty please if someone can help me to sort the errors.

Thank you in advance. Much appreciated.

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
2

There are 2 best solutions below

1
On

First, there is no need to use Windows API functions for the ribbon custom UI:

#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

Second, there is no need to return a pointer to the ribbon UI instance:

#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

All you need to have is a ribbon XML which defines the structure of controls with callbacks defined in the code. The Fluent UI (aka Ribbon UI) is described in depth in the following series of articles:

0
On

A Custom Ribbon does not work on Libre Office. Libre Office does not make allowance for Custom Ribbons.

Tested: This customUI Ribbon code runs fine in any Windows and Office release.