Ribbon-Fehler
09.05.2019 16:26:28
Albert
ich verwende nachfolgenden Code in zwei Dateien, um nach einem Klick
auf ein Ribbon eine Anmeldeprozedur durchführen zu lassen.
Je nach Benutzer öffnet sich dann weiter ein weiteres Ribbon-Menü oder nicht.
Ich bin am Verzweifeln, da der Code in der ersten Datei tadellos funktioniert und
in der zweiten Datei nicht.
Wenn ich den Error-Handler im Code RefreshRibbons auskommentiere, dann bleibt
der Cursor innerhalb der If-Anweisung bei gobjRibbon.Invalidate mit einem
"with Block Fehler" stehen.
Ich hab keine Ahnung was da sein könnte.
Option Private Module
Option Explicit
Public objRibbon As IRibbonUI
Public gobjRibbon As IRibbonUI
Public Path As String
Public Name As String
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 Sub RefreshRibbons()
Dim objName As Name
'Error handler
On Error GoTo aEnd
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
aEnd:
End Sub
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
Besten Dank für eure Tipps und Hilfe.Gruß
A.