excelvbacheckboxribbon-controlribbonx

Excel Custom Ribbon toggle button dependency


I'm trying to put together a custom menu, and I want 2 of the toggleButtons:"chkToggle1" and "chkToggle2" to exclude each other, meaning that when 1 is checked the other is not and vice versa.

            <checkBox id="chkToggle1" getLabel="onGetLabel" getScreentip="onGetScreentip"   getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" />
            <checkBox id="chkToggle2" getLabel="onGetLabel" getScreentip="onGetScreentip"   getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" />

Can you guys give any ideas on how I can do that? Ideally there should be a way to get the pressed value from another control by control.id without using global variables, but Google is not helping me, maybe you can.


Solution

  • In my XML for the workbook I've got:

    <customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad = "RibbonOnLoad">
        <ribbon>
            <tabs>
                <tab id="customTab" label="Contoso" insertAfterMso="TabHome">
                    <group id="customGroup" label="Contoso Tools">
                        <checkBox id="chkToggle1" tag="chkToggle1" getLabel="onGetLabel" getScreentip="onGetScreentip" getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" getEnabled="GetEnabled" />
                        <checkBox id="chkToggle2" tag="chkToggle2" getLabel="onGetLabel" getScreentip="onGetScreentip" getSupertip="onGetSupertip" getPressed="GetPressed" onAction="tgl_ClickAddin" getEnabled="GetEnabled" />
                    </group>
                </tab>
            </tabs>
        </ribbon>
    </customUI>
    

    I've Added a Sheet to my workbook called RibbonReference (Which I'd recommend setting .Visible = xlSheetVeryHidden) and then added the following to a Module:

    Option Explicit
    Dim rib As IRibbonUI
    Public ControlTag As String
    
    Private Declare Function ShellExecute _
      Lib "shell32.dll" Alias "ShellExecuteA" ( _
      ByVal hWnd As Long, _
      ByVal Operation As String, _
      ByVal Filename As String, _
      Optional ByVal Parameters As String, _
      Optional ByVal Directory As String, _
      Optional ByVal WindowStyle As Long = vbMinimizedFocus _
      ) As Long
    
    #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 RefreshRibbon()
        If rib Is Nothing Then
            Set rib = GetRibbon(ThisWorkbook.Sheets("RibbonReference").Cells(2, 1).Value)
        Else
            rib.Invalidate
        End If
    End Sub
    Sub RibbonOnLoad(ribbon As IRibbonUI)
        Set rib = ribbon
        Debug.Print "ribbon:-", ObjPtr(ribbon)
        ThisWorkbook.Sheets("RibbonReference").Cells(2, 1).Value = ObjPtr(ribbon)
    End Sub
    Sub GetEnabled(control As IRibbonControl, ByRef enabled)
        If control.Tag = ControlTag Or ControlTag = vbNullString Then
            enabled = True
        Else
            enabled = False
        End If
    End Sub
    
    'Callback for chkToggle1 getPressed
    Sub GetPressed(control As IRibbonControl, ByRef returnedVal)
        If ControlTag = control.Tag Then
            returnedVal = True
        Else
            returnedVal = False
        End If
    End Sub
    
    'Callback for chkToggle1 onAction
    Sub tgl_ClickAddin(control As IRibbonControl, pressed As Boolean)
        If ControlTag = control.Tag Then
            ControlTag = vbNullString
        Else
            ControlTag = control.Tag
        End If
        RefreshRibbon
    End Sub
    'Callback for chkToggle1 getLabel
    Sub onGetLabel(control As IRibbonControl, ByRef returnedVal)
    End Sub
    
    'Callback for chkToggle1 getScreentip
    Sub onGetScreentip(control As IRibbonControl, ByRef returnedVal)
    End Sub
    
    'Callback for chkToggle1 getSupertip
    Sub onGetSupertip(control As IRibbonControl, ByRef returnedVal)
    End Sub
    

    Giving the result

    enter image description here