Excel-Absturz bei Ribbon-Aktualisierung
06.05.2014 12:43:02
Hendrik
folgenden Code habe ich aus den Seiten des Netzes kopiert, da ich in meinem Addin ein Ribbon ansprechen möchte:
Private Const NAMES_NAME = "Ribbon"
'Durch VBA7 wird auf 64-Bit-Version geprüft.
#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 ThenFunction 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
Public 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
gobjRibbon.ActivateTab ("htbTab")
End Sub
Das funktioniert auf meinem Rechner auch prima. Wenn ich es aber auf dem Rechner eines Kollegen installiere, bricht es an der StelleCall CopyMemory(objRibbon, lRibbonPointer, LenB(lRibbonPointer))
ab. Und zwar ohne Fehlermeldung oder änliches, sondern mit einem Komplettaufhänger von Excel.
Leider verstehe ich die Stelle zu wenig, als das ich sie reparieren könnte. Was ist da wohl das Problem?