A Workbook-Hooker with no Ribbon-related fatalities

A Workbook-Hooker with no Ribbon-related fatalities

I’ve been working on an addin that uses application-level events to “hook” certain “target” workbooks as they open, in order to control menus and other functionality for the target workbooks. I like this setup because the code is all in the addin, so code updates don’t bother users and they don’t have to enable macros.

The Basics

The application class is created when the addin starts, and application-level events track the opening and closing of target workbooks. When a target opens, a workbook class is instantiated. That gets added to a dictionary object that contains all currently open target workbooks. The workbook class shows the ribbon tab when the workbook is activated and hides it when the workbook is deactivated.

I had never created an addin like this using ribbon menus. Creating a new ribbon group is easy using Andy Pope’s RibbonX Visual Designer. And I added the ribbon loss-of-state insurance Ron de Bruin demonstrates. But the ribbon did cause problems when I tried to address a couple of potential usage situations.

The Tricky Parts

If the addin is not checked in the Addins dialog, I want it to behave well when a user does check it. This means that if a target workbook is already open, the menu should be shown when the addin starts. The menu should also be shown if a user opens Excel by clicking on a target workbook in Windows Explorer. I tried to set this up in the addin’s ThisWorkbook module by calling initialization code from the Addin_Install and Workbook_Open events. However, this consistently crashed Excel in these two situations. Somehow my code was colliding with the ribbon’s instantiation. I tried to solve this by delaying initialization with Application.OnTime. This worked for the addin-activation scenario, but not for the Windows Explorer one. My code was somehow trying to run at the same time, or before, the ribbon’s code.

Finally, finally, it hit me that the solution was to call all my initialization code from the Ribbon_OnLoad event. That seems to have fixed the problem, and now there’s no code in the addin’s ThisWorbook module at all.

One other thing I learned was that an application-level Workbook_Open event is fired when you attempt to re-open an open workbook, either from Windows Explorer or in Excel. This could lead to trying to re-add a workbook to the Dictionary if the user accidentally tried to open an already open workbook, so I just re-load the dictionary each time.

The Code

(You can also follow the link at the end of this post to downdoad the addin and two targets.)

Here’s the Application Class module, called clsApplication. Along with hooking target workbooks when they open, it removes them from the collection when they’re closed, using the application’s BeforeClose and Deactivate events.

Public WithEvents App As Excel.Application
Private mboolWbClosing As Boolean

Private Sub App_WorkbookOpen(ByVal wb As Workbook)
If WbIsTargetWorkbook(wb) Then
    FillDictionary
End If
End Sub

Private Sub App_WorkbookBeforeClose(ByVal wb As Workbook, Cancel As Boolean)
'The last close might have been cancelled
mboolWbClosing = False
If gdicTesterWorkbooks.Exists(wb.Name) Then
    'It might be closing, but the close might be cancelled
    mboolWbClosing = True
End If
End Sub

Private Sub App_WorkbookDeactivate(ByVal wb As Workbook)

If mboolWbClosing Then
'Okay, it's really closing
    If gdicTesterWorkbooks.Exists(wb.Name) Then
        gdicTesterWorkbooks.Remove wb.Name
    End If
    mboolWbClosing = False
End If
End Sub

This is the clsTargetWorkbook class.

Public WithEvents wb As Excel.Workbook

Private Sub Class_Initialize()
SetRibbonVisibility True
End Sub

Sub wb_Activate()
SetRibbonVisibility True
End Sub

Sub wb_Deactivate()
SetRibbonVisibility False
End Sub

Last is a module with the remaining code. It includes global variables to track the comings and goings of the ribbon, along with the class and dictionary declarations. Below that is the section that helps retrieve the ribbon reference should it be lost, followed by the subs for the actual ribbon events. Finally, there’s routines to manage the application class and dictionary, test for target workbooks, and show and hide the ribbon. (It probably goes without saying that the real version doesn’t use workbook names to test for target workbooks.)

'thanks to Rory Archibald and Ron de Bruin for Ribbon
'loss-of-state prevention code
'http://www.rondebruin.nl/ribbonstate.htm

Public gRibbon As IRibbonUI
Public cApplication As clsApplication
Public cTargetWorkbook As clsTargetWorkbook
Public gdicTesterWorkbooks As Object
Public gboolShowRibbonTab As Boolean

#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#Else
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#End If

#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

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)
Set gRibbon = ribbon
ThisWorkbook.Names.Add Name:="RibbonPointer", RefersTo:=ObjPtr(ribbon)
ThisWorkbook.Saved = True

'only do our initialization after the ribbon's

InitializeGlobals
FillDictionary
End Sub

Sub InvalidateRibbon()
If gRibbon Is Nothing Then
    Set gRibbon = GetRibbon(Replace(ThisWorkbook.Names("RibbonPointer").RefersTo, "=", ""))
End If
gRibbon.Invalidate
End Sub

Public Sub grpRibbonTester_getVisible(control As IRibbonControl, ByRef returnedVal)
returnedVal = gboolShowRibbonTab
End Sub

Public Sub cmdTester_onAction(control As IRibbonControl)
MsgBox "testing"
End Sub

Sub InitializeGlobals()
Set cApplication = New clsApplication
Set cApplication.App = Application
Set gdicTesterWorkbooks = CreateObject("Scripting.Dictionary")
End Sub

Sub FillDictionary()
Dim wb As Excel.Workbook
Dim cTargetWorkbook As clsTargetWorkbook

Set gdicTesterWorkbooks = Nothing
Set gdicTesterWorkbooks = CreateObject("Scripting.Dictionary")
For Each wb In Workbooks
    If WbIsTargetWorkbook(wb) Then
        Set cTargetWorkbook = New clsTargetWorkbook
        Set cTargetWorkbook.wb = wb
        gdicTesterWorkbooks.Add cTargetWorkbook.wb.Name, cTargetWorkbook
    End If
Next wb
End Sub

Function WbIsTargetWorkbook(wb As Excel.Workbook)
If wb.Name = "Target1.xlsx" Or wb.Name = "Target2.xlsx" Then
    WbIsTargetWorkbook = True
End If
End Function

Sub SetRibbonVisibility(boolRibbonVisible As Boolean)
gboolShowRibbonTab = boolRibbonVisible
InvalidateRibbon
End Sub

The Download, Should You So Desire

A zipped file with the addin, and two target workbooks. Install the addin, open the workbooks, or vice-versa.

Speak Your Mind

Your email address will not be published. Required fields are marked *

To post code, do this: <code> your vba here </code>