Keep control of the Office Ribbon

Description

Object Reference

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

Persistant Storage

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: