Developers who have done any kind of programming with the Office 2007 (and later) Ribbon architecture have encountered almost certainly a scenario that resulted in the loss of their pointer to the ribbon. This happens because the ribbon object has to be stored in a global variable and any kind of unhandled error leads to a “loss of state,” which includes the loss of all global variables.
Rory Archibald came up with an ingenious way to protect the ribbon object by saving the pointer address in an Excel cell. See http://www.mrexcel.com/forum/showpost.php?p=2562883&postcount=7.
On a parallel path, I had decided on a different approach to the issue by developing a separate add-in that did nothing more than save global variables in a VBA collection. While this required coordination across two add-ins, the benefits included the ability to extend the solution to platforms other than Excel, the ability to save the state of any global, and also a solution that did not require a Windows API. My solution is documented in 1018 Protect a global variable in another VBProject.shtml.
This note fleshes out Rory’s approach and makes it compatible to 32-bit and 64-bit Office platforms. Why write this note if my preferred approach is something else? Well, it demonstrates, in a reasonably compact example, how to write code that is compatible with (1) different versions of Office (2010 as well as earlier versions) and (2) both 32-bit and 64-bit Office 2010 platforms.
The techniques used in this note, in particular the use of a LongPtr data type, the PtrSafe keyword, and the compiler constant VBA7, are explained in 1016 Office 2010 VBA.shtml.
An object variable in VBA is implemented as a handle, which is a pointer to a pointer that, in turn, points to the actual memory location containing the data for the object. So, the basic idea behind recovering a global object after state loss is to save the value of the handle somewhere that is protected against the state loss. This could be an Excel worksheet cell or an Excel workbook named constant.
On a 32-bit platform a handle is a 32-bit (4 byte) variable. The largest possible value conveniently fits within the 15 digits of precision that Excel supports. However, on a 64-bit platform, a handle is a 64-bit (8 byte) variable and sufficiently large values will exceed Excel’s 15 digit precision. So, we have to store the value of the handle not as a number but as a string.
A key limitation with this technique is that the object variable of interest must be declared outside of the VB project of the workbook containing this code. This is because we are storing the contents of the handle, i.e., the memory location it is pointing to, in a cell (or a name). When the VB project loses state the global handle declared in this project will be lost. After this state loss the system will delete any object that no longer has a handle pointing to it. So, the only way that the object that we are interested in will continue to exist is if there still is at least one other handle pointing to it – and, obviously, this handle must be outside the VB project that has just suffered a state loss.
So, we cannot use this technique to protect a global object variable declared and used exclusively in the same project.
Given a global object variable and a name to associate it with, the subroutine saveGlobal saves it as a named constant in the workbook containing the code.
Next, given the name associated with a global object that was previously saved, the code in getGlobal retrieves the value of the handle from the saved name. Then, the object handle is ‘reset’ to the previous value with the CopyMemory API call.
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (destination As Any, source As Any, _
ByVal length As Long)
#Else
Public Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (destination As Any, source As Any, _
ByVal length As Long)
#End If
Public Sub saveGlobal(Glbl As Object, GlblName As String)
#If VBA7 Then
Dim lngRibPtr As LongPtr
#Else
Dim lngRibPtr As Long
#End If
lngRibPtr = ObjPtr(Glbl)
With ThisWorkbook
On Error Resume Next
.Names(GlblName).Delete
On Error GoTo 0
.Names.Add GlblName, lngRibPtr
.Saved = True
End With
End Sub
Function GetGlobal(GlblName As String) As Object
#If VBA7 Then
Dim X As LongPtr
X = CLngPtr(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
#Else
Dim X As Long
X = CLng(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
#End If
Dim objRibbon As Object
CopyMemory objRibbon, X, Len(X)
Set GetGlobal = objRibbon
End Function
The callback routines in the code below are associated with the ribbon elements shown in Figure 1.
Figure 1
The ribbon tab is TM Examples and the group is Excel and VBA Cases. The first element in the group is a toggle button with the label provided by a VBA callback routine, named getLabel. It shows the time of the last call to the getLabel routine. The Cause Fault button calls a routine that causes a VBA fault.
Excel calls the ribbonLoaded procedure when opening the workbook (or loading the add-in). The procedure updates the global handle (guiRibbon) with the parameter passed to it. In addition, it saves the value of the handle using the saveGlobal procedure.
Clicking the Cause Fault button calls the causeFault procedure, which simply causes a fault. The result is a loss of state and guiRibbon will become nothing.
When the user presses the testToggle button (the label is the time when it was last updated), the toggleAction procedure invalidates the ribbon. Consequently, Excel calls the getLabel procedure, which, in turn, updates the label of the toggle button with the current time. However, if the Cause Fault button was pressed before the call to toggleAction, the variable guiRibbon will be nothing. In that case, toggleAction calls the getGlobal function to reinstate the guiRibbon handle.
Option Explicit
Public guiRibbon As IRibbonUI
Dim BtnPressed As Boolean
Public Sub ribbonLoaded(ribbon As IRibbonUI)
Set guiRibbon = ribbon
saveGlobal ribbon, "RibbonPtr"
End Sub
'Callback for testToggle onAction
Sub toggleAction(control As IRibbonControl, pressed As Boolean)
'Debug.Print Now, BtnPressed, pressed
BtnPressed = pressed
If guiRibbon Is Nothing Then Set guiRibbon = GetGlobal("RibbonPtr")
guiRibbon.Invalidate
End Sub
'Callback for testToggle getPressed
Sub getPressed(control As IRibbonControl, ByRef returnedVal)
returnedVal = BtnPressed
End Sub
Sub getLabel(control As IRibbonControl, ByRef returnedLabel)
returnedLabel = Format(Now(), "hh:mm:ss")
End Sub
'Callback for causeFault onAction
Sub causeFault(control As IRibbonControl)
Debug.Print 1 / 0
End Sub
The XML associated with the ribbon elements in Figure 1 is below.
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
xmlns:TMPub="_TMPub"
onLoad="saveGlobalRibbonX.RibbonLoaded">
<ribbon startFromScratch="false">
<tabs>
<tab idQ="TMPub:TMPublish" label="TM Examples">
<group idQ="TMPub:TMCases"
label="Excel and VBA Cases">
<toggleButton id="testToggle"
onAction="toggleAction"
getPressed="getPressed"
getLabel="getLabel" />
<button id="doFault"
label="Cause fault"
onAction="causeFault" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>
