1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
| Option Explicit
#If Mac Then
Private Declare PtrSafe Function CopyMemory_byVar Lib "libc.dylib" Alias "memmove" (ByRef dest As Any, ByRef src As Any, ByVal size As Long) As LongPtr
Dim lRibbonPointer As LongPtr
#Else
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Any, ByVal src As LongPtr, ByVal size As LongPtr)
Dim lRibbonPointer As LongPtr
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef dest As Any, ByVal src As Long, ByVal size As Long)
Dim lRibbonPointer As Long
#End If
#End If
#If VBA7 Then
Function GetRibbon(ByVal lRibbonPointer As LongPtr) As IRibbonUI
#Else
Function GetRibbon(ByVal lRibbonPointer As Long) As IRibbonUI
#End If
Dim objRibbon As IRibbonUI
If lRibbonPointer <> 0 Then
#If Mac Then
CopyMemory_byVar objRibbon, lRibbonPointer, LenB(lRibbonPointer)
#Else
CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
#End If
End If
Set GetRibbon = objRibbon
End Function
Sub SafeRibbon()
On Error GoTo ErrorHandler
MsgBox "Tentative de récupération du ruban"
lRibbonPointer = ThisWorkbook.Sheets(1).Range("a2").Value
Set myRibbon = GetRibbon(lRibbonPointer)
If Not myRibbon Is Nothing Then
myRibbon.Invalidate
Else
MsgBox "Erreur : impossible de récupérer l'objet Ribbon."
End If
Exit Sub
ErrorHandler:
MsgBox "Erreur : " & Err.Description
End Sub |
Partager