VBA Excel - customizing ribbonx issue - unhide tab when opening file with filename containing string

[jdjehanneman]

Hello,

I have a problem with my custom ribbon.
I would like Every time a file is opened, whether at Excel startup or via a control in a userform, to check whether the name of the file to be opened contains the string "Manage" and if so, make a custom tag visible.

The check should be done everytime a workbook is opened:
1. When the file was opened from within Excel
2. When a new file is created
2. When opening a file from a custom userform:

Private Sub bt_OpenManager_Click()
    Dim strTemplateFilePath As String
    Dim wb As Excel.Workbook

    If listbox_Paths_Managers.ListIndex <> -1 Then
        strTemplateFilePath = PATH_CICTOOLS_ADMIN & listbox_Paths_Managers.List(listbox_Paths_Managers.ListIndex)
        FrmTemplateManager.Hide
        Set wkb = Workbooks.Open(strTemplateFilePath)
    End If
End Sub

in the xml code I have put the following code :

<tab id="MyCustomTab2" label="CIC-Tools Templates" getVisible="GetVisible" tag="cictools_savetemplates">

In the VBA project I have created a module, RibbonModule:

Dim Rib As IRibbonUI
Dim MyTag As String

' Callback for customUI.onLoad
' make tab cictools_savetemplates visible if opened filename contains "Manage" in the name
Sub RibbonOnLoad(ribbon As IRibbonUI)
    Set Rib = ribbon
    RibPointer = ObjPtr(ribbon)
    If Contains = InStr(ThisWorkbook.Name, "Manage") > 1 Then
        Call RefreshRibbon(Tag:="cictools_savetemplates")
    End If
End Sub

'Called by sheet change event handler (module Sheet1) to make Excel recreate the ribbon
Sub RedoRib()
    If Rib Is Nothing Then
        Set Rib = GetRibbon(RibPointer)
        Rib.Invalidate
        MsgBox "The Ribbon handle was lost, Hopefully this is sorted now by the GetRibbon Function?. You can remove this msgbox, I only use it for testing"
    Else
        Rib.Invalidate
    End If
End Sub

Sub GetVisible(control As IRibbonControl, ByRef visible)
    If control.Tag Like MyTag Then
        visible = True
    Else
        visible = False
    End If
End Sub

Sub RefreshRibbon(Tag As String)
    MyTag = Tag
    If Rib Is Nothing Then
        MsgBox "Error, restart your workbook"
    Else
        Rib.Invalidate
    End If
End Sub

When I open the file from the user form the check doesn't work because ThisWorkbook.Name is not the just opened workbook but the .xlam file controling the VBA:

InStr(ThisWorkbook.Name, "Manage")

The test is never met and my tab is not getting visible.

I hope I am clear enough, it is rather complex to explain.

Thank you in front for your help!

Johan

 

[RoryA]

Why are you testing Thisworkbook.Name, rather than wkb.Name?

 

[jdjehanneman]

Why are you testing Thisworkbook.Name, rather than wkb.Name?

Hi Rory,

Tried several alternatives (activeworkbook, workbook,...) but none of them solve the problem.

 

[RoryA]

Assuming you want to refer to the active workbook, the syntax would be:

If InStr(1, ActiveWorkbook.Name, "Manage", vbTextCompare) <> 0 Then

 

[jdjehanneman]

After a couple of hours of work I solved some of my issues with the ribbon. By storing the pointer in the registry so I can recreate it anytime. I think Rory most of the code comes from other posts of zou. This solves some other problems I had with the ribbon:

Option Explicit

Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)

Dim Rib As IRibbonUI
Dim MyTag As String


'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
    Dim lRibPointer As LongPtr
    Dim res As Boolean
    Set Rib = ribbon                    'GET RIBBON
    lRibPointer = ObjPtr(ribbon)        'GET RIBBON ID
    res = Functions_SetBFPKey("RibbonPointer", CStr(lRibPointer))   ' Write ribbonpointer to the registry
    MyTag = "cictools"
End Sub

' when Ribbon object is lost -> recreate it using the object pointer stored in the registry
Function getRibbon() As IRibbonUI
    If Rib Is Nothing Then
        Dim ribbonPointer As Long
        ribbonPointer = GetPointer()
        Call CopyMemory(Rib, ribbonPointer, 4)
    End If
    Set getRibbon = Rib
End Function

'make Excel recreate the ribbon from the pointer stored in the registry
Sub RedoRib()
    If Rib Is Nothing Then
        Set Rib = getRibbon()
        Rib.Invalidate
    Else
        Rib.Invalidate
    End If
End Sub

Sub RefreshRibbon(Tag As String, Optional TabID As String)
    MyTag = Tag
    If Rib Is Nothing Then
        Call RedoRib
    Else
        Rib.Invalidate
    End If
End Sub

Sub GetVisible(control As IRibbonControl, ByRef visible)
    If control.Tag Like MyTag Then
        visible = True
    Else
        visible = False
    End If
End Sub

' Get the ribbonpointer from the registry
Function GetPointer()
    Dim tmp As String
    tmp = Functions_GetBFPKey("RibbonPointer")
    GetPointer = CLng(tmp)
End Function

On the other hand I still don't manage to show/hide "MyCustomTab1" and "MyCustomTab2" depending on the name of the file I'm opening. All my code is stored in an .xlam and fires whenever a workbook is opened. I tried to use the Workbook.Open() event:

Public Sub Workbook_Open()
    If InStr(1, ThisWorkbook.Name, "Manage", vbTextCompare) <> 0 Then
        Call RefreshRibbon(Tag:="cic*")
    End If
End Sub

But nothing happens -> because when opening the workbook with Workbook.Open() ThisWorkbook.Name = the name of the .xlam .
Which object and which event should I use to test if the workbook should have both or just one custom tab activated.

Thx in front

 

[RoryA]

That Workbook_open is only triggered when your add-in opens. You need to be using application level events to trap any workbook opening. Check (the late, great) Chip Pearson’s website for examples of how to do that.

 

[jdjehanneman]

Thx Rory for the input. I will check the website of Chip Pearson and look into the Application level events.