What is the alternative for CopyMemory API to recover Excel IRibbonUI

Question

I use below code to retrieve the IRibbonUI that was set on ribbon callback in Template_Rib global variable that randomly losing its value.

But the CopyMemory API makes the Excel crash randomly. Is there any alternative for this CopyMemory API?

#If VBA7 Then
  Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
#Else
  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
#End If
Public Template_Rib As IRibbonUI
Public Sub CallbackOnLoad(ribbon As IRibbonUI)
#If VBA7 Then
  Dim StoreRibbonPointer As LongPtr
#Else
  Dim StoreRibbonPointer As Long
#End If
Set Template_Rib = ribbon
Template_Rib.ActivateTab "TemplateTab" 'Name of the tab to activate
'Store pointer to IRibbonUI in a Named Range within add-in file
StoreRibbonPointer = ObjPtr(ribbon)
ThisWorkbook.Names.Add Name:="RibbonID", RefersTo:=StoreRibbonPointer
End Sub
Sub TryToRetrieveRibbon()
On Error GoTo ErrorHandler
If Template_Rib Is Nothing Then
  Set Template_Rib = GetRibbon(Replace(ThisWorkbook.Names("RibbonID").RefersTo, "=", ""))
  'Set Template_Rib = GetRibbon(Evaluate(ThisWorkbook.Names("RibbonID").Value))
End If
ErrorHandler:
Err.Clear
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
  CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
  Set GetRibbon = objRibbon
  Set objRibbon = Nothing
End Function

Answer 1

in fact it's a very stupid reason the reason is that since vba 7 especially on 32 bit excel versions but also on click&run versions the copymemory api is asynchronous with the lenB of the pointer the solution is to use a long variable before using copymemory and to use this variable instead of lenB in the formulation

patricktoulon :)

sample

    'callback created by [[''creatorRibbonX'']]
'[createRibbonX Application] created by (''patricktoulon'')
'Version 2024 5.2
'POUR MEMO 4 fonctions importantes à connaitre pour les controls dynamiques
'L 'objet IRibbonUI possède 4 méthodes :
'1° myribbon.Invalidate() qui actualise en une seule fois tous les contrôles personnalisés du classeur.
'2° myribbon.InvalidateControl("Id du control") qui actualise un contrôle particulier (ControlID correspond à l'identificateur unique du contrôle).
'3° myRibbon.ActivateTab ("id de l'onglet à activer")qui active l'onglet désigné par son ID dans les parenthèses
'4° myRibbonInvalidateControlMso ("Id de l'element"(onglet/group/control) )qui actualise l'element désigné par son ID dans les parenthèses



'Nom du projet:[C:\Users\patricktoulon\Desktop\CreatorRibbonX V4.9 et V5.0\creatorRibbonX 4.9.9.X\Project_switch_onglet_developer_visible\exemple.xml]
'créé le:[29/12/2024]

Public myRibbon As IRibbonUI ' {Variable pour l'object ribbon}
Public boolbool As Boolean

#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr)
#Else
    Public Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
#End If

Sub KILLRIBBON()
    Set myRibbon = Nothing
End Sub
Function GetSavedRibbon() As IRibbonUI
    Dim objRibbon As IRibbonUI
    #If VBA7 Then
        Dim lRibbonPointer As LongPtr
    #Else
        Dim lRibbonPointer As Long
    #End If
    Dim lRibbonSize&, mess$
    On Error GoTo erreur
    lRibbonPointer = CLngPtr(Replace(Names("NhRibbon").Value, "=", ""))
    If lRibbonPointer = 0 Then mess = "Pointeur invalide (0).": GoTo erreur
    lRibbonSize = LenB(lRibbonPointer)
    If lRibbonSize <= 0 Then mess = "Taille invalide pour le pointeur.": GoTo erreur
    CopyMemory objRibbon, lRibbonPointer, lRibbonSize
    If objRibbon Is Nothing Then mess = "Impossible de recréer l'objet Ribbon.": GoTo erreur
    Set GetSavedRibbon = objRibbon ' Assigner l'objet récupéré à la fonction
    CopyMemory objRibbon, 0&, lRibbonSize ' Nettoyage
    Set objRibbon = Nothing
    Exit Function
erreur:
    MsgBox "Le ruban n'a pas pu être récupéré." & vbCrLf & mess & vbCrLf & _
            "Vous devez redémarrer l'application.", vbCritical, "Erreur"
    On Error GoTo 0
End Function
'**********************************************
'utilisation avant de faire un des 4 invalidate dans vos events dynamique
'If myRibbon is nothing then set myRibbon=GetSavedRibbon
'**********************************************'Callback pour l' event customUI.onLoad
Sub CustomUIOnLoad(ribbon As IRibbonUI)
    Set myRibbon = ribbon
    ActiveWorkbook.Names.Add Name:="NhRibbon", RefersTo:=ObjPtr(myRibbon)
End Sub

'l'event ribbon Load_Image
Public Sub Ribbon_loadImage(imageId As String, ByRef image)
    Set image = LoadPicture(ThisWorkbook.Path & "\images\" & imageId)
End Sub

'procedure {getvisible} du tab [idMso :''TabDeveloper'']  []'dans le parent [tabs '' ]
'valeur par defaut
Sub TabBuild_Getvisible(control As IRibbonControl, ByRef returnedVal)
    returnedVal = boolbool
End Sub

'procedure {onAction} du bouton [ID:''button_1'' Label:''onglet developpeur'']'dans le parent [group_0'' Label:''Groupe N° 1'']
Sub onglet_developpeur_Click(control As IRibbonControl)
    boolbool = Not boolbool
    If myRibbon Is Nothing Then Beep: Set myRibbon = GetSavedRibbon
    myRibbon.InvalidateControlMso ("TabDeveloper")
End Sub

Answer 2

I don't think there is an alternative to CopyMemory for that, but I might have an idea why your implementation might be unstable.

First, have you made sure that CallbackOnLoad is actually called? It happened to me in the past where I would edit the custom XML for the ribbon, but forget to specify the onload property in the top tag. Eg.:

<customUI onLoad="CallbackOnLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui" >

It's probably not your case since refreshing the ribbon would never work in that case, so it wouldn't be random in that sense, but I thought I'd mention it just in case.

---

Secondly, in theory the pointer for the ribbon is a 64-bit integer (assuming 64-bit OS) and it could be bigger than what Excel Names can store. (I'm saying in theory because while I was testing it, I wasn't able to get anything bigger than a 42-bit integer.)

For instance, you could not store the upper limit of an unsigned 64-bit integer (9,223,372,036,854,775,807) inside a name because it will only store the first 15 significant digits, which limits you to a 999,999,999,999,999 which is a 50-bit integer).

To prevent this from happening randomly, you could store the pointer as a string like this:

ThisWorkbook.Names.Add Name:="RibbonID", RefersTo:=Chr(34) & StoreRibbonPointer & Chr(34)

Then, you can retrieve and use the pointer with something like this:

Dim StringPtr As String
StringPtr = Replace(Replace(ThisWorkbook.Names("RibbonID").RefersTo, "=", ""), Chr(34), "")
#If VBA7 Then
    Set ObjRibbon = GetRibbon(CLngPtr(StringPtr))
#Else
    Set ObjRibbon = GetRibbon(CLng(StringPtr))
#End If

---

Thirdly, you've defined the 3rd parameter for RtlMoveMemory as a Long using the & type declaration suffix. However, when you are passing LenB(lRibbonPointer), you are actually passing an Integer. You can convince yourself of that by putting a breakpoint on the line with CopyMemory and then run the following in the Immediate Window:

?TypeName(LenB(lRibbonPointer)) '-> Integer

To make sure that you pass a Long variable, you can use a Long to make sure that the conversion occurs in your code instead of inside the Windows API function which might lead to an unstable outcome.

Dim Length As Long
Length = LenB(lRibbonPointer)
CopyMemory objRibbon, lRibbonPointer, Length 

Related answers:

• https://stackoverflow.com/a/55074052/5958842
• https://stackoverflow.com/a/50576127/5958842