Option Explicit
Dim mrbnRibbon As IRibbonUI  'пользовательский интерфейс

#If VBA7 Then
     Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
            pDst As Any, _
            pSrc As Any, _
            ByVal ByteLen As Long)
#Else
     Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
                    pDst As Any, _
                    pSrc As Any, _
                    ByVal ByteLen As Long)
#End If

'---------------------- ЗАГРУЗКА ЛЕНТЫ ---
Sub RibbonLoading(ribbon As IRibbonUI)
     Set mrbnRibbon = ribbon                  ' интерфейс в переменную
     SetRegVal ObjPtr(ribbon), gsRIBBON_POINTER, gsPARAM_TYPE1     ' указатель на IRibbonUI _
                    у меня он записывается в реестр, _
                    можно куда угодно, откуда его легко получит при падении, в ячейку, напр.
End Sub

#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If
CopyMemory GetRibbon, lRibbonPointer, LenB(lRibbonPointer)
End Function

Sub RefreshRibbon()              ' эта процедура поднимает риббон, если это возможно.
     If mrbnRibbon Is Nothing Then
         Dim sPnt As String: sPnt = vGetRegVal(gsRIBBON_POINTER)       ' СЧИТЫВАЕТСЯ ИЗ РЕЕСТРА.
         If Len(sPnt) = 0 Then
             MsgBox "Указатель на ленту не найден." & vbCr & _
                    "Нужно перезагрузить надстройку.", vbCritical
             End    '<<<=====[XXX] - УКАЗАТЕЛЬ НА ЛЕНТУ ОТСУТСТВУЕТ!!!

         Else
             Dim objTemp As Object: Set objTemp = GetRibbon(sPnt)
             If TypeName(objTemp) <> "IRibbonUI" Then
                 MsgBox "Некорректный указатель на ленту." & vbCr & _
                        "Нужно перезагрузить надстройку.", vbCritical
                 DelRegVal gsRIBBON_POINTER
                 End    '<<<=====[XXX] - УКАЗАТЕЛЬ НЕ НА ЛЕНТУ!!!
             End If
         End If

         Set mrbnRibbon = objTemp
         Debug.Print Now & " - cсылка на ленту восстановлена!"

     End If

     mrbnRibbon.Invalidate

End Sub
'=========================================================================

Option Explicit
Public Sub SetRegVal(vVal, Optional sParamPath As String = gsREG_PATH0, _
                       Optional sParamType As String = gsPARAM_TYPE0)
' [sParamPath] - записываем параметр (По умолчанию)
'                ключа "HKEY_CURRENT_USER\Software\Sanya\Add-ins\Ribbon\"
      On Error GoTo errHandler
      If sParamType = gsPARAM_TYPE1 Then
          If Not IsNumeric(vVal) Then
              Err.Raise 666, , _
                        "Для типа параметра " & gsPARAM_TYPE1 & " необходимо число, " & _
                        "а не это: " & Chr(34) & vVal & Chr(34) & vbCr
          End If
      End If
      '===================================================================
      Dim WshShell As Object: Set WshShell = CreateObject("WScript.Shell")
      WshShell.RegWrite sGetFullPath(sParamPath), vVal, sParamType  '<<<<<<<<<<<<<<<<<<<<<<
      Exit Sub
errHandler:
      MarkError "записи", Err.Description
End Sub

Public Function vGetRegVal(Optional sParamPath As String = gsREG_PATH0) As Variant
' [sParamPath] - получаем параметр (По умолчанию)
'                ключа "HKEY_CURRENT_USER\Software\Sanya\Add-ins\Ribbon\"
      On Error GoTo errHandler
      Dim WshShell As Object: Set WshShell = CreateObject("WScript.Shell")
      vGetRegVal = WshShell.RegRead(sGetFullPath(sParamPath))     '<<<<<<<<<<<<<<<<<<<<<<
      Exit Function
errHandler:
      MarkError "чтения", Err.Description
End Function

Public Sub DelRegVal(Optional sParamPath As String = gsREG_PATH0)
' [sParamPath] - удаляем ключ "HKEY_CURRENT_USER\Software\Sanya\Add-ins\Ribbon\"
      On Error GoTo errHandler
      Dim WshShell As Object: Set WshShell = CreateObject("WScript.Shell")
      WshShell.RegDelete sGetFullPath(sParamPath)    '<<<<<<<<<<<<<<<<<<<<<<
      Exit Sub
errHandler:
      MarkError "удаления", Err.Description
End Sub

'--------------------------------------------------------------------------
Private Function sGetFullPath(ByVal sIn As String) As String
      Dim sPref As String: sPref = ""
      If Left$(sIn, 4) <> "HKEY" Then sPref = gsREG_PATH0
      sGetFullPath = sPref & sIn
End Function

Private Sub MarkError(sType As String, sErrDescr As String)
      Debug.Print Now & " - ошибка " & sType & ":" & vbCr & sErrDescr & vbCr
End Sub

Option Explicit
Public Const gsPARAM_TYPE0 As String = "REG_SZ"
Public Const gsPARAM_TYPE1 As String = "REG_DWORD"

Public Const gsRIBBON_POINTER As String = "RibbonPointer"
Public Const gsCOUNTER As String = "Counter"

Public Const gsREG_PATH0 As String = "HKEY_CURRENT_USER\Software\Sanya\Add-ins\Ribbon\"

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private IRibbon As IRibbonUI

Property Let Current_Ribbon(ribbon As IRibbonUI)
Set IRibbon = ribbon
Me.Names.Add Name:="Current_Ribbon", RefersTo:=ObjPtr(ribbon)
End Property
Property Get Current_Ribbon() As IRibbonUI
Dim IPoint As Long
If IRibbon Is Nothing Then
     IPoint = Evaluate("Current_Ribbon")
     CopyMemory IRibbon, IPoint, LenB(IPoint)
End If
Set Current_Ribbon = IRibbon
End Property

Option Explicit

Sub IRibbon_onLoad(ribbon As IRibbonUI)
'При первой загрузке, сохраняем объект Ribbon и его адрес
Current_Ribbon = ribbon

'Далее, работаем с объектом Ribbon, возращаемым свойством Current_Ribbon
'При этом мы гарантированно получаем Ribbon - либо "родной", либо восстановленный после возможных сбоев
With Current_Ribbon
      .ActivateTab ("Home")
      .Invalidate
End With
End Sub