RibbonX-Workshop - IRibbonUI - Objekt wiederherstellen

In der Regel verwende ich "objRibbon.Invalidate" zum Aktualisieren eines Ribbon. Es kann jedoch vorkommen dass das Office-Programm die Bindung zum Ribbon-Objekt verliert. Es gibt jedoch die Möglichkeit, das Ribbon-Objekt zu speichern, sodass das Office-Programm das Objekt sauber wiederherstellen kann. Mit folgendem Code ist das möglich. Der Code wurde zur Verfügung gestellt von Isabelle:;)

Hinweis:
1. Der Beispielcode wurde für Excel geschrieben. Der Name des Ribbon-Objekts wird als unsichtbarer Name in der Excel-Datei gespeichert. Für Word/PowerPoint muss der Code geringfügig angepasst werden (in der Zeile ThisWorkbook.Names.Add)
2. Sie müssen den Namen des onLoad-Ereginisses noch an Ihre Bedürfnisse anpassen.
3. Der Code ist sowohl in der 64-bit-Version als auch in der 32-bit-Version von Office 2010-2013 lauffähig.
4. Nach dem Einfügen des Codes in Ihr Projekt nutzen Sie Call RefreshRibbon anstelle von objRibbon.Invalidate


Option Private Module

Private Const NAMES_NAME = "Ribbon"

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

Public gobjRibbon As IRibbonUI

Public Sub onLoad(pobjRibbon As IRibbonUI)
    Dim objName As Name
    Set gobjRibbon = pobjRibbon
    ThisWorkbook.Names.Add Name:=NAMES_NAME, RefersTo:=CStr(ObjPtr(pobjRibbon)), Visible:=False
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
    Call CopyMemory(objRibbon, lRibbonPointer, LenB(lRibbonPointer))
    Set GetRibbon = objRibbon
    Set objRibbon = Nothing
End Function

Sub RefreshRibbon()
    Dim objName As Name
    If gobjRibbon Is Nothing Then
        For Each objName In ThisWorkbook.Names
            If objName.Name = NAMES_NAME Then
                #If VBA7 Then
                    Set gobjRibbon = GetRibbon(CLngPtr(Mid$(objName.RefersTo, 2)))
                #Else
                    Set gobjRibbon = GetRibbon(CLng(Mid$(objName.RefersTo, 2)))
                #End If
                Exit For
            End If
        Next
        Set objName = Nothing
        gobjRibbon.Invalidate
    Else
        gobjRibbon.Invalidate
    End If
End Sub