RibbonX - Setting pressed state of Checkbox control at runtime

[nikki333]

Hi Folks

I've got a custom menu group with a menu holding 3 checkboxes. Now, I'd like to make it act like a drop box, that is if one of the 3 buttons gets pressed the other 2 get unpressed.

So far I've got the following XML code:

<?xml version="1.0" encoding="utf-8"?>


<customUI onLoad="subRibbonOnLoad" xmlns="http://schemas.microsoft.com/office/2009/07/customui">
    <ribbon startFromScratch="false" >
            <tabs>
            <tab idMso="TabHome">
                  <group id="Ansicht_Allg" label="Ansicht Allgemein" insertBeforeMso="GroupClipboard" getVisible="subGetVisible" tag="wsAllg">
                <menu id="Menu_wsAllg_Filter" image="Icon_Level" size="large" label="Level" screentip="Level an Detail auswählen">
                    <checkBox id="CheckBox_5_wsAllg" tag="L1" label="Level 1 Komptetenzen" getPressed="subGetPressed" screentip="Level 1 Kompetenzen" onAction="btnMatrixAnsicht" />
                    <checkBox id="CheckBox_6_wsAllg" tag="L2" label="Level 2 Themen"  getPressed="subGetPressed" screentip="Level 2 Themen" onAction="btnMatrixAnsicht" />    
                    <checkBox id="CheckBox_7_wsAllg" tag="L3" label="Level 3 Trainings" getPressed="subGetPressed" screentip="Level 3 Trainings" onAction="btnMatrixAnsicht" />
                </menu>
                </group>
         </tab>

......

And the following VBA callbacks:

'Menüband laden (Callback für customUI.onLoad; wird beim Öffnen der Datei ausgeführt)
Sub subRibbonOnLoad(ribbon As IRibbonUI)


    'Variablen dimensionieren/speichern
    Set rbnRib = ribbon


    If Not ObjPtr(ribbon) = 0 Then
        With wsHelfer
            .Unprotect
            .Range("B3").Value = ObjPtr(ribbon)
            .Protect
        End With
    End If


End Sub


'Menüband aktualisieren/neu zeichnen (Callback für CustomUI.invalidate; wird beim Öffnen/Blattwechsel ausgeführt)
Sub subRefreshRibbon(Tag As String)


    'Variablen dimensionieren/speichern
    strRibbonTag = Tag
    
    If rbnRib Is Nothing Then
        If Not CStr(wsHelfer.Range("B3")) = "" Then
            Set rbnRib = fctgetribbon(wsHelfer.Range("B3").Value)
            rbnRib.Invalidate
        End If
    Else
        rbnRib.Invalidate
    End If


End Sub


'Pointer für zu ladendes Menüband ermitteln (i.e Speicherort des Menübandstatuses im Arbeitsspeicher)
Function fctgetribbon(ByVal rbnPointer As LongPtr) As IRibbonUI


    CopyMemory rbnRib, rbnPointer, LenB(rbnPointer)
    Set fctgetribbon = rbnRib


End Function


'Menüband wechseln (Callback für CustomUI.subGetVisible; wird beim Blattwechsel ausgeführt)
Sub subGetVisible(control As IRibbonControl, ByRef visible)


    If control.Tag = strRibbonTag Then
        visible = True
    Else
        visible = False
    End If


End Sub


Sub subGetPressed(control As IRibbonControl, ByRef pressed)


End Sub


'Button onAction (Callback für CustomUI.onAction; wird beim Drücken eines Buttons ausgeführt)
Sub btnMatrixAnsicht(control As IRibbonControl, pressed As Boolean)


    Dim wsAktivesBlatt As Worksheet: Set wsAktivesBlatt = ThisWorkbook.ActiveSheet
    Dim strButtonTyp As String
    Dim strButtonIndex As String
    Dim strAnsichtlevel As String
    Dim blnButtonGedrückt As Boolean
    
    If control.Tag Like "L*" Then
        strButtonTyp = "Level"
        strAnsichtlevel = Right(control.Tag, 1)
    Else
        strButtonTyp = "Kompetenzen"
        strAnsichtlevel = control.Tag
    End If
    If pressed = True Then
        blnButtonGedrückt = True
    Else
        blnButtonGedrückt = False
    End If
    strButtonIndex = Mid(control.ID, InStr(1, control.ID, "_") + 1, 1)
    
    subMatrixAnsicht wsAktivesBlatt, strButtonTyp, strButtonIndex, strAnsichtlevel, blnButtonGedrückt
    
End Sub

I've tried with getPressed, however, the corresponding subGetPressed doesn't get called when pressing any of the 3 buttons.
Any ideas how this can be done?

[Paul_Hossler]

It'd be easier to check if you attached a small WB wih the code that shows the issue

[nikki333]

Hi Paul

Thank you for your quick reply; I had to zip it because of the size issue.

The custom buttons are located at the beginning of the start tabs and the callbacks are located inside the module "modRibbonX"

In fact, there are 2 menus on each sheet. The buttons in the first one should act like checkboxes, which works fine. Those in the second menu should act like dropdown.

The reason for that is simply that I don't like the dropdown visual style.


Matrix_v2.zip

[Paul_Hossler]

Edit - looking at your example, this doesn't do the Menu part. I'll look at that part now -- Sorry I focused on the check boxes as plain checkboxes



I thought it'd be easier (esp. for me ) to make just a small example that seems to do what you want

I think this shows the overall concepts, and if it works for you, you'll need to integrate it

Option Explicit

Dim B1 As Boolean, B2 As Boolean, B3 As Boolean
Dim oRibbon As IRibbonUI

'Callback for customUI.onLoad
Sub OnRibbonLoad(ribbon As IRibbonUI)
    
    Set oRibbon = ribbon
    
    B1 = True
    B2 = False
    B3 = False
    oRibbon.Invalidate
End Sub

'Callback for CheckBox onAction
Sub OnAction(control As IRibbonControl, pressed As Boolean)
    B1 = False
    B2 = False
    B3 = False
    
    Select Case control.ID
        Case "CheckBox1"
            B1 = True
        Case "CheckBox2"
            B2 = True
        Case "CheckBox3"
            B3 = True
    End Select
    
    oRibbon.Invalidate
    
End Sub


'Callback for CheckBox1 getPressed
Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
    Select Case control.ID
        Case "CheckBox1"
            returnedVal = B1
        Case "CheckBox2"
            returnedVal = B2
        Case "CheckBox3"
            returnedVal = B3
    End Select
End Sub

[Paul_Hossler]

Try this menu version and see if it's closer

No images or anything and all it does is check/uncheck

Option Explicit

Dim B1 As Boolean, B2 As Boolean, B3 As Boolean, B4 As Boolean
Dim oRibbon As IRibbonUI


'Callback for customUI.onLoad
Sub OnRibbonLoad(ribbon As IRibbonUI)
    
    Set oRibbon = ribbon
    
    B1 = True
    B2 = False
    B3 = False
    B4 = False
    oRibbon.Invalidate
End Sub



'Callback for  onAction
Sub OnAction(control As IRibbonControl, pressed As Boolean)
    B1 = False
    B2 = False
    B3 = False
    B4 = False
    
    Select Case control.ID
        Case "MenuToggleButton1"
            B1 = True
        Case "MenuToggleButton2"
            B2 = True
        Case "MenuToggleButton3"
            B3 = True
        Case "MenuToggleButton4"
            B4 = True
    End Select
    
    oRibbon.Invalidate
    
End Sub



'Callback for getPressed
Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
    Select Case control.ID
        Case "MenuToggleButton1"
            returnedVal = B1
        Case "MenuToggleButton2"
            returnedVal = B2
        Case "MenuToggleButton3"
            returnedVal = B3
        Case "MenuToggleButton4"
            returnedVal = B4
    End Select
End Sub

[Paul_Hossler]

I moved the thread to the FluentUI forum so that anyone else who might be interested can find it a little easier

[nikki333]

Thank you Paul

I'm glad to hear to you were struggling too I think I'm on the right track to integrate this concept into my file.

What I didn't yet understand is why you set the boolean variables (B1, B2, B3) in the ribbon onLoad callback already

[Paul_Hossler]

Use the macro in post #5


If they were 'linked' Option Buttons then selecting OB1 would automatically unselect which ever was previously selected from OB2, OB3, or OB4 (1 combination)

These are Toggle Button and TB1 and/or TB2 and/or TB3 and/or TB4 could be pressed (16

combinations

)

Using the 4 Booleans tracks the status so that when one toggle button is selected (OnAction), the other toggle buttons can be turned off (GetPressed)

Probably other ways to do it, but I've found the KISS is best

[Paul_Hossler]

Here's another way that does not use the 4 Booleans

Actually, I kinda like this better

Option Explicit
Dim sSelected As String
Dim oRibbon As IRibbonUI

'Callback for customUI.onLoad
Sub OnRibbonLoad(ribbon As IRibbonUI)
    
    Set oRibbon = ribbon
    sSelected = "MenuToggleButton1"
    oRibbon.Invalidate
End Sub


'Callback onAction
Sub OnAction(control As IRibbonControl, pressed As Boolean)
    sSelected = control.ID
    oRibbon.Invalidate
End Sub


'Callback getPressed
Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = (control.ID = sSelected)
End Sub

[nikki333]

I'm stil on the way to implement your solution.

The problem, however, is that I've got 12 sheets with the same, yet sheet-specific buttons. And when pressing one of the buttons in either sheet, the getpressed status gets updated in all of the sheets the same. But each sheet should have it's own state.

[nikki333]

Right now, I'm saving the button state in a helper table. For example, sheet x has 7 custom buttons, and the state of these buttons is found in the said table as binary (e.g. 0101010)

What I'd like to achieve on custom Button press is:

- get the state from said table and modify the bit related to the pressed button
- change the pressed state of each custon menu button in the active sheet according to the modified button state from said helper table

[Paul_Hossler]

I'm confused a little

You have 4 toggle buttons on the ribbon and 12 sheets, and the state and result of the 4 toggle buttons are controlled by

which sheet is active?

[Paul_Hossler]

Take a look at this example

I just have 4 sheets, but the pressed togglebutton is saved in a collection and reset when you reenter the sheet. I used the Workbook events

The numbers in A1 don't mean anything -- just my test markers

Option Explicit


Private Sub Workbook_Open()
    Dim ws As Worksheet
    
    Set collPressed = New Collection
    
    'set all to first one
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible Then
            collPressed.Add "MenuToggleButton1", ws.Name
        End If
    Next
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    sPressed = collPressed.Item(Sh.Name)
    oRibbon.Invalidate
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    collPressed.Remove Sh.Name
    collPressed.Add sPressed, Sh.Name
End Sub

[nikki333]

The thing is that i have the same buttons for 12 sheets. but each sheet should have it's own state

Therefore the idea was to register each and every state change in the helper table as binary and retrieve it when activating a tab

[Paul_Hossler]

Maybe we crossed in the mail, but that's what the workbook in my #13 post does but using a collection instead of a table

[nikki333]

Thank you Paul, that helped a lot