PDA

View Full Version : [SOLVED] RibbonX - Setting pressed state of Checkbox control at runtime



nikki333
02-17-2019, 09:17 AM
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
02-17-2019, 09:39 AM
It'd be easier to check if you attached a small WB wih the code that shows the issue

nikki333
02-17-2019, 10:20 AM
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.


23755

Paul_Hossler
02-17-2019, 10:36 AM
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
02-17-2019, 10:57 AM
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
02-17-2019, 12:03 PM
I moved the thread to the FluentUI forum so that anyone else who might be interested can find it a little easier

nikki333
02-17-2019, 12:09 PM
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
02-17-2019, 02:02 PM
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
02-17-2019, 02:11 PM
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
02-20-2019, 01:05 PM
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
02-20-2019, 01:11 PM
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
02-20-2019, 02:39 PM
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
02-20-2019, 03:02 PM
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
02-20-2019, 03:10 PM
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
02-20-2019, 03:22 PM
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
03-01-2019, 03:28 PM
Thank you Paul, that helped a lot :)