The Microsoft Office Ribbon is referenced as an IRibbonUI object. The reference is retrieved by implementing:
Public gobjRibbon As IRibbonUI Sub CallbackOnLoad(ribbon As IRibbonUI) Set gobjRibbon = ribbon End Sub
Unfortunatly the global variable gobjRibbon is only initialized once, and is lost after errors or during a reset from the VBA-IDE.
A user "WernerGg" has published a brilliant solution for Excel, based on the work of user rorya (Rory) from the MrExcel board: http://www.mrexcel.com/forum/showthread.php?t=518629 and http://www.thecodecage.com/forumz/top-tips/208306-excel-store-regain-iribbonui-object-reference.html.
How to preserve or regain the Id of my custom ribbon UI?The problem is that the UI is initialized only once during load. To change enabled-state or visibility, controls must be forced to reinitialize. For that we have to store the UIs Id during load by means of the onLoad-callback.
But this Id can only be stored in a static variable (Private guiRibbon As IRibbonUI), which gets lost after errors or during reset from the VBA-IDE.
We have implemented code to store the guiRibbon at a save place (a defined name "thisWorkbook_IRibbonUI_Ptr" on cell H2 in this example) from where it can be retrieved when the static variable is lost. See module ObjectStore. Basically it does:Sub StoreObjRef(obj As Object) ' Store an object reference Dim longObj As Long longObj = ObjPtr(obj) Range("...") = longObj End Sub Function RetrieveObjRef() As Object ' Retrieve the object reference Dim longObj As Long, obj as Object longObj = Range("...") CopyMemory obj, longObj, 4 Set RetrieveObjRef = obj End Function ' where CopyMem is a Windows kernel function: Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)For the entire sample and description please see the file TestRibbonUI_3.xlsm by WernerG
The method of storing values in named ranges or worksheet cells only works with Excel, for the additional Office Applications we must find another storage location.
On the website http://www.cpearson.com/excel/trulyglobalvariables.htm, Chip Pearson describes how to create truly global variables in Excel. If we combine this with the sample from WernerG, we can place the Ribbon pointer in a truly global persistant variable.
First we implement object storage in the truly global variable module.
Public Const C_OBJ_STORAGENAME As String = "AC_RIBBON_PTR" Private Declare Sub CopyMemory Lib "kernel32" _ Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long) Public Function StoreObjRef(obj As Object) As Boolean ' Serialize and savely store an object reference StoreObjRef = False ' Serialize Dim longObj As Long longObj = ObjPtr(obj) ' Store into a defined name If Not PropertyExists(C_OBJ_STORAGENAME) Then SetProperty C_OBJ_STORAGENAME, longObj Debug.Print "Save storage """; C_OBJ_STORAGENAME; """ stored the object reference"; longObj StoreObjRef = True Else Debug.Print "Property exists" End If ' Return End Function Public Function RetrieveObjRef() As Object ' Retrieve from save storage, deserialize and return the object reference ' stored with StoreObjRef Set RetrieveObjRef = Nothing ' Retrieve from a defined name Dim longObj As Long If PropertyExists(C_OBJ_STORAGENAME) Then If GetProperty(C_OBJ_STORAGENAME, longObj) Then Debug.Print "Object reference"; longObj; "retrieved from save storage """; C_OBJ_STORAGENAME; """" ' Deserialize Dim obj As Object CopyMemory obj, longObj, 4 ' Return Set RetrieveObjRef = obj Set obj = Nothing Else Debug.Print "object not retrieved" End If Else Debug.Print "object does not exist" End If End Function
Then we add the call to store the reference:
Public gobjRibbon As IRibbonUI Sub CallbackOnLoad(ribbon As IRibbonUI) Set gobjRibbon = ribbon Storage.StoreObjRef ribbon End Sub
Additionally we add a function to retrieve the object again, for performance issues we check to see if we still have the "local" copy first.
Function getRibbonObj() as object If gobjRibbon Is Nothing Then Set gobjRibbon = Storage.RetrieveObjRef End If set getRibbonObj = gobjRibbon End Function
However for use in other Office Applications the code will need a little modification. In his original file Chip has defaulted the DestHWnd to:
If HWnd <= 0 Then DestHWnd = FindWindow("XLMAIN", Application.Caption) Else DestHWnd = HWnd End If
However this is not terribly dynamic and we have changed it to:
If HWnd <= 0 Then DestHWnd = GetDefaultHandle() Else DestHWnd = HWnd End If
Additionally the GetDefaultHandle() was introduced. Obviously this should be expanded to include the main windows of the remaining Office Applications
Private Function GetDefaultHandle() As Long If Application.name = "Microsoft Access" Then GetDefaultHandle = Application.hWndAccessApp ElseIf Application.name = "Microsoft Excel" Then GetDefaultHandle = FindWindow("XLMAIN", Application.Caption) Else MsgBox "Undefined Application" End If End Function
The code consists of two files: