Ribbon kann nicht mehr geprüft werden?, CopyMemory 64-Bit

[Stefan1]

Guten Tag miteinander

Bis jetzt konnte ich mit CopyMemory in der 32-Bit-Version ohne Problem den "TestRibbon" abarbeiten. Doch mit der neuen 64-Bit-Version kommt zwar keine Fehlermeldung, doch "If gobjRibbon Is Nothing... " ergibt immer "Nothing". Ich erkenne einfach nicht, was hier falsch ist? Danke für jede Unterstützung. Wahrscheinlich muss ich ausprobieren das "VarPtr" wegzulassen, dass noch zur 32-Bit-Version gehörte?

Gruss
Stefan 1
 

Code:

Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As LongPtr)                                                                                             
Public Sub OnRibbonLoad(ribbon As IRibbonUI)
'Callbackname in XML File "onLoad"          'In Betrieb
    Set gobjRibbon = ribbon
    SaveSetting "msoFile", CONmenuNEW, "objRibbonVar", ObjPtr(ribbon)
    On Error Resume Next
    If val(Application.Version) > 12 Then gobjRibbon.ActivateTab CONmenuNEW
    On Error GoTo 0
End Sub

Public Function TestRibbon() As Boolean
Dim varRegWert As Variant
    If gobjRibbon Is Nothing Then
        varRegWert = CVar(GetAllSettings(appName:="msoFile", section:=CONmenuNEW))
        If IsEmpty(varRegWert) = False Then
            'MsgBox GetSetting("msoFile", CONmenuNEW, "objRibbonVar")
            Set gobjRibbon = GetRibbon(CLngPtr(GetSetting("msoFile", CONmenuNEW, "objRibbonVar")))
            If gobjRibbon Is Nothing Then
                TestRibbon = False
            Else
                TestRibbon = True
            End If
        End If
    Else
        TestRibbon = True
    End If
End Function

Public Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
Dim NewobjRibbon As Object
    CopyMemory VarPtr(NewobjRibbon), lRibbonPointer, LenB(lRibbonPointer)
    Set GetRibbon = NewobjRibbon
    Set NewobjRibbon = Nothing
    CopyMemory NewobjRibbon, 0&, 4
    If Err.Number > 0 Then Err.Clear
End Function

'Rückstellen
Public Sub DeleteSettingInfo()
    If IsEmpty(CVar(GetAllSettings(appName:="msoFile", section:=CONmenuNEW))) = False Then DeleteSetting "msoFile", CONmenuNEW
End Sub

'Beispiel eines Forums Teilnehmer:
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
  Dim objRibbon As Object
  CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
  Set GetRibbon = objRibbon
  Set objRibbon = Nothing
End Function

[mumpel]

Hallo!

Wie ist "gobjRibbon" deklariert?

Gruß, René

[Stefan1]

Guten Tag René
Das "gobjRibbon" ist als "IRibbonUI" deklariert, was bis jetzt immer funktioniert hat. Vielen Dank für Deine Unterstützung.
Gruss
Stefan

[Stefan1]

Guten Tag zusammen 
Irgendwo steckt hier der Wurm drin. Ich habe alle Vorschläge ausprobiert von Set d = xx bis zu LongPtr. Jetzt kommt sogar noch "Arumenttyp ByRef unverträglich" bei "CopyMemory NewobjRibbon ...". Bei der 32-bit-Version hat das funktioniert. Wenn ich das Step-by-Step durchgehe, stürzt es manchmal ab, jedoch auf jeden Fall beim Starten er Arbeitsmappe. Nur wenn ich "TestRibbon" quasi ausschalte, dann ist in Ordnung. Leider sehe ich den Fehler nicht und bitte nochmals um Unterstützung. 
Gruss
Stefan1

Code:

'Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)        ---> Original
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As Long)
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
Public gobjRibbon As IRibbonUI
Public bolRibSta As Boolean
Public bolSpeich As Boolean
Public bolEnabled As Boolean    ' Used in Callback "getEnabled"
Public bolVisible As Boolean    ' Used in Callback "getVisible"
Public Type ItemsVal
    id As String
    label As String
    imageMso As String
End Type
Public Sub OnRibbonLoad(ribbon As IRibbonUI)
'Callbackname in XML File "onLoad"          'In Betrieb
    Set gobjRibbon = ribbon
    SaveSetting "msoFile", CONmenuNEW, "objRibbonVar", ObjPtr(ribbon)
    On Error Resume Next
    If val(Application.Version) > 12 Then gobjRibbon.ActivateTab CONmenuNEW
    On Error GoTo 0
End Sub
Public Function TestRibbon() As Boolean
Dim varRegWert As Variant
    If gobjRibbon Is Nothing Then
        varRegWert = CVar(GetAllSettings(appName:="msoFile", section:=CONmenuNEW))
        If IsEmpty(varRegWert) = False Then
            Set gobjRibbon = GetRibbon(CLngPtr(GetSetting("msoFile", CONmenuNEW, "objRibbonVar")))
            If gobjRibbon Is Nothing Then
                TestRibbon = False
            Else
                TestRibbon = True
            End If
        End If
    Else
        TestRibbon = True
    End If
End Function

Public Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
Dim NewobjRibbon As Object
    CopyMemory NewobjRibbon, lRibbonPointer, LenB(lRibbonPointer)
    Set GetRibbon = NewobjRibbon
    Set NewobjRibbon = Nothing
    CopyMemory NewobjRibbon, 0&, 4
    If Err.Number > 0 Then Err.Clear
End Function

[mumpel]

Brauchst Du zwingend die 64-bit-Version? Sonst gehe zurück zur 32-bit-Version. Bei der 64-bit-Version kann ich nicht helfen.

[OnlineExcel]

Hi,
hier gibt es vielerlei anzumerken:
Meines Erachtens ist ein restoring des Ribbons nur auf dem Developer Rechner von nöten. Auf den Anwender Rechnern eher nicht.
Und wenn man dies richtig abfängt kann zumindest Excel nicht crashen.
Da ich grundsätzlich auf 32 Bit Excel entwickle und dann auf 64 bit teste habe ich bis jetzt keine Probleme damit - obwohl ich mir dies demnächst sicherlich mal anschaue.
Denn irgendetwas geht da schief mit den Long und LongPtr, da scheinen falsche Datentypen eingesetzt zu werden in der LongPtr von CopyMemory

Des weiteren ist es wahrscheinlich auch entscheidend, wie der Pointer zum Ribbon gespeichert wird und wie die einzelnen Typen abhängig von der Bit Version von Excel umgesetzt werden. Allein schon ein falsches Ablegen in der Registry wird funken wenn der Typ falsch ist.

Und jetzt kommt etwas, wofür man mich wohl steinigt:

Eine solche Frage wird mit Sicherheit in einem englischen Forum besser aufgehoben sein, sei es Mr.Excel oder Stack Overflow. Auch das googlen in english bringt hier mehr.

Grundsätzlich würde ich dir empfehlen, wenn du auf 64 bit Excel entwickelst, deinen ganzen vorhandenen Code bezüglich Store Ribbon und Restore Ribbon wegzuschmeißen, die Registry aufzuräumen und das Thema komplett neu beginnen. Das wird dir viel Zeit sparen.

Viele API Grüße

[Stefan1]

Guten Abend
Ja, die Deklaration von CopyMemory 64-Bit ist eigentlich ein-zu-ein wie es Microsoft empfiehlt, aber ich gehege auch den Verdacht, dass Long und LongPtr nicht passen. Leider habe ich nirgends diesbezüglich ein brauchbaren Code für 64-Bit gefunden (das ich nicht wechseln kann), jedoch einige Leidensgenossen, die nach einer Lösung suchen.
Gruss
Stefan

[Stefan1]

Guten Tag OnlineExcel

In der Tat würde alles aufgeräumt und auf 64-bit umgebaut, inkl. Microsoft Api-Deklarationsliste mit den "offiziellen" neuen Deklarationen für 64-bit. Eigentlich ist nur noch dieses Ribbon mit dem CopyMemory übrig geblieben. Das andere wurde auch auf 32-bit entwickelt und läuft mit den exakten Anpassungen ohne Probleme auf 64-bit. Es scheint wieder mal etwas zu sein, wo man sehr lange auf eine Lösung wartet bis bzw. jemand das herausfindet. Doch das wird Angesicht des "veralteten" VBA immer weniger der Fall sein. Schade eigentlich   
Gruss und vielen Dank für Deine Unterstützung.
Stefan 1

[mumpel]

Das hätte aber nicht sein müssen. Wenn es keinen zwingenden Grund für den Einsatz der 64-bit-Version gibt, sollte man bei der 32-bit-Version bleiben.

[Stefan1]

Guten Tag Mumpel
Ja, auf 64-bit-Version hatte ich keinen Einfluss darauf. Aber ich habe jetzt doch ein lauffähigen Code gebastelt:
Warum jetzt (Habe ich an Beispielen abgeguckt) mit "Dim ribValue AS String" und "If Len(ribValue) > 0 Then ..." sowie die "Else ... und End If" plötzlich keine Fehler mehr habe und das Ganze sogar funktioniert (True und False), ist für mich ein Rätsel. Mich würde schon noch interessieren bei Anwendung des originalen MS API-64-bit-Code CopyMemory warum das jetzt plötzlich so geht? Auch das mit dem "VarPtr" verstehe ich nicht ganz? Braucht es das jetzt oder nicht oder hat das einen Zusammenhang mit "ByVal"? Wie könnte ich den Code optimieren bzw. noch sicherer und schneller machen?
Vielen Dank für Eure Unterstützung.
Gruss
Stefan1

Code:

….
If TestRibbon = True Then Call Application.OnTime(EarliestTime:=Now, Procedure:="SwitchTabMain")
….
If TestRibbon = True Then gobjRibbon.InvalidateControl "btnSpeichern"

Public Sub SwitchTabMain()
    On Error Resume Next
    gobjRibbon.ActivateTab CONmenuNEW: If Err.Number < 0 Then Err.Clear
End Sub

Public Function TestRibbon() As Boolean
Dim varRegWert As Variant
Dim ribValue As String
    If gobjRibbon Is Nothing Then
        varRegWert = CVar(GetAllSettings(appName:="msoFile", section:=CONmenuNEW))
        If IsEmpty(varRegWert) = False Then
            varRegWert = GetSetting("msoFile", CONmenuNEW, "objRibbonVar")
            If Len(varRegWert) > 0 Then
                Set gobjRibbon = GetRibbon(CLngPtr(varRegWert))
                If gobjRibbon Is Nothing Then
                    TestRibbon = False
                Else
                    TestRibbon = True
                End If
            Else
                TestRibbon = False
            End If
        End If
    Else
        TestRibbon = True
    End If
End Function

Public Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
Dim NewobjRibbon As IRibbonUI
    CopyMemory VarPtr(NewobjRibbon), lRibbonPointer, LenB(lRibbonPointer)
    Set GetRibbon = NewobjRibbon
    Set NewobjRibbon = Nothing
    CopyMemory NewobjRibbon, 0&, 4
    If Err.Number > 0 Then Err.Clear
End Function