RibbonX-Workshop - IRibbonUI - Objekt wiederherstellen

Du bist einem veralteten Link gefolgt, dieser Inhalt ist über eine neue URL erreichbar.
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