vba 功能区中维护值的复选框

Checkbox in Ribbon who maintain the value

提问by Iban Arriola

I add a checkBox in the ribbon using xml (with Custom UI Editor for Microsoft Office) That exec vba code. I need this checkBox to maintain the value (checked or unchecked) even if I close the application. Right now when I close and open it, the checkBox appears always unchecked.

我使用 xml（使用 Microsoft Office 的自定义 UI 编辑器）在功能区中添加了一个复选框，该 exec vba 代码。即使我关闭应用程序，我也需要此复选框来维护值（选中或未选中）。现在，当我关闭并打开它时，复选框始终未选中。

I also need to know if it is possible to know if this checkbox is checked or not using vba

我还需要知道是否可以使用 vba 知道是否选中了此复选框

回答by Vikas

To make it simpler, here is what you should do. You need to decide how you will be returning or storing the value. Whether to use XML/Registry/CustomXML etc etc. Once you have decided, do these steps.

为了使它更简单，这是你应该做的。您需要决定如何返回或存储值。是否使用 XML/Registry/CustomXML 等。一旦决定，请执行以下步骤。

Ribbon XML:

功能区 XML：

<checkBox id="cbStoreValue" label="MyCheckBox" getPressed="Function_Clicked" onAction="Function_Action" />

VBA Code:

VBA 代码：

Public Function Function_Clicked(control As IRibbonControl, ByRef pressed)
    pressed = GetKey
End Function

Public Function Function_Action(control As IRibbonControl, pressed As Boolean)
    Store pressed
End Function

Public Sub Store(value As Boolean)
    '''write the code for storing the key, may be to an ini file, or registry or an external xml, custom xml or custom document property
End Sub

Public Function GetKey() As Boolean
    '''write the code for getting the key back from the source which you might have used to store the value.
    '''return the correct value here
    GetKey = True ' or whatever you have selected previously

End Function

Hope this helps :)

希望这可以帮助 ：）

Vikas B

维卡斯 B

回答by Fahad Al-Dossary

Use any Program to insert Below Custom Ribbon XML Code into Excel Book

使用任何程序将下面的自定义功能区 XML 代码插入到 Excel 工作簿中

<!--RibbonX Visual Designer (64-bit) 2.44 for Microsoft Excel CustomUI14 . XML Code produced on 2018/06/02-->
<customUI 
 xmlns="http://schemas.microsoft.com/office/2009/07/customui"
 onLoad="RefreshControls">
 <ribbon >
  <tabs >
   <tab 
    id="Tab1"
    insertBeforeMso="TabHome"
    label="Tab1">
    <group 
     id="Group1"
     label="Text Control">
     <box 
      boxStyle="vertical"
      id="Box1">
      <editBox 
       id="Editbox1"
       label="Editbox1"
       getText="Editbox_getText"
       onChange="Editbox_onChange"/>
      <comboBox 
       id="Combobox1"
       label="Combobox1"
       getItemCount="Combobox_getItemCount"
       getItemLabel="ComboboxgetItemLabel"
       getText="Combobox_getText"
       onChange="Combobox_onChange"/>
      <dropDown 
       id="Dropdown1"
       label="Dropdown1"
       getItemCount="Dropdown_getItemCount"
       getItemLabel="Dropdown_getItemLabel"
       getSelectedItemIndex="Dropdown_getSelectedItemIndex"
       onAction="GetAction"/>
     </box >
    </group >
    <group 
     id="Group2"
     label="Normal">
     <box 
      boxStyle="vertical"
      id="Box2">
      <checkBox 
       id="Checkbox1"
       label="Checkbox1"
       getPressed="Checkbox_getPressed"
       onAction="Checkbox_onAction"/>
      <checkBox 
       id="Checkbox2"
       label="Checkbox2"
       getPressed="Checkbox_getPressed"
       onAction="Checkbox_onAction"/>
      <checkBox 
       id="Checkbox3"
       label="Checkbox3"
       getPressed="Checkbox_getPressed"
       onAction="Checkbox_onAction"/>
     </box >
     <separator  id="Separator1" />
    </group >
    <group 
     id="Group3"
     label="Option Button">
     <box 
      boxStyle="vertical"
      id="Box3">
      <checkBox 
       id="Checkbox4"
       label="Checkbox4"
       getPressed="Checkbox_getPressed"
       onAction="Checkbox_onAction"/>
      <checkBox 
       id="Checkbox5"
       label="Checkbox5"
       getPressed="Checkbox_getPressed"
       onAction="Checkbox_onAction"/>
      <checkBox 
       id="Checkbox6"
       label="Checkbox6"
       getPressed="Checkbox_getPressed"
       onAction="Checkbox_onAction"/>
     </box >
    </group >
    <group 
     id="Group4"
     label="Normal">
     <box 
      boxStyle="horizontal"
      id="Box4">
      <toggleButton 
       id="Togglebutton1"
       size="normal"
       getLabel="Togglebutton_getLabel"
       getPressed="Togglebutton_getPressed"
       onAction="Togglebutton_onAction"/>
      <toggleButton 
       id="Togglebutton2"
       size="normal"
       getLabel="Togglebutton_getLabel"
       getPressed="Togglebutton_getPressed"
       onAction="Togglebutton_onAction"/>
      <toggleButton 
       id="Togglebutton3"
       size="normal"
       getLabel="Togglebutton_getLabel"
       getPressed="Togglebutton_getPressed"
       onAction="Togglebutton_onAction"/>
     </box >
    </group >
    <group 
     id="Group5"
     label="Option Button">
     <box 
      boxStyle="horizontal"
      id="Box5">
      <toggleButton 
       id="Togglebutton4"
       size="normal"
       getLabel="Togglebutton_getLabel"
       getPressed="Togglebutton_getPressed"
       onAction="Togglebutton_onAction"/>
      <toggleButton 
       id="Togglebutton5"
       getLabel="Togglebutton_getLabel"
       getPressed="Togglebutton_getPressed"
       onAction="Togglebutton_onAction"/>
      <toggleButton 
       id="Togglebutton6"
       getLabel="Togglebutton_getLabel"
       getPressed="Togglebutton_getPressed"
       onAction="Togglebutton_onAction"/>
     </box >
    </group >
   </tab >
  </tabs >
 </ribbon >
</customUI >

Then into Normal Module insert below Code

然后进入普通模块插入下面的代码

You Can store the check box and Other Controls values in the application, with replace values inside load or getKey Function using this Function Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)

您可以在应用程序中存储复选框和其他控件值，使用此函数 Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String) 在 load 或 getKey 函数中替换值

    Option Explicit

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

    Public RefreshRibbon As IRibbonUI
    Public EditboxText As String
    Public ComboboxText As String
    Public ComboItemCount As Long
    Public Dropdown As String
    Public DropdownItemCount As Long
    Public DropdownSelectedItem As Long
    Public ChkBx(1 To 6) As Boolean
    Public Tglbtn(1 To 6) As Boolean

    Public Sub RefreshControls(ribbon As IRibbonUI)
            Set RefreshRibbon = ribbon ' Set Ribbon onLoad

            saveGlobal RefreshRibbon, "RibbonPtr" 'This Function to Save and ReStore Ribbon after Replacing Below Items or any Fault
            ' Contnue Replacing to save values of Ribbon Controls Using:   Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)'

            EditboxText = "Day" ' EditboxText1 Text value

            ''''''''''''''''''''''''
            ComboboxText = "AAA"        ' Combobox1 Text value
            ComboItemCount = 6          '           Itmes Count

            '''
            Dropdown = "Friday"         ' Dropdown1: Text value
            DropdownItemCount = 6       '            Itmes Count
            DropdownSelectedItem = 5    '            Itme Number

            '''
            ChkBx(1) = True            'Free select (1 to 3)
            ChkBx(2) = True
            ChkBx(3) = True
            '''
            ChkBx(4) = False            'One selected Option From Group select (4 to 6)
            ChkBx(5) = True
            ChkBx(6) = False

            Tglbtn(1) = False            'Free select (1 to 3)
            Tglbtn(2) = True
            Tglbtn(3) = False
            '''
            Tglbtn(4) = False            'One selected Option From Group select (4 to 6)
            Tglbtn(5) = False
            Tglbtn(6) = True


    End Sub

    Public Sub Editbox_getText(control As IRibbonControl, ByRef returnedVal)
    If control.id = "Editbox1" Then
    returnedVal = EditboxText
    End If
    End Sub
    Public Sub Editbox_onChange(control As IRibbonControl, Text As String)
    EditboxText = "Day"

    Fnd = ""
    Fnd = "EditboxText = " & """" & EditboxText & """"
    Rplc = ""
    Rplc = "EditboxText = " & """" & Text & """"
    VBRplcr "RefreshControls", Fnd, Rplc
    VBRplcr "Editbox_getText", Fnd, Rplc
    VBRplcr "Editbox_onChange", Fnd, Rplc
    If control.id = "Editbox1" Then

    EditboxText = Text
    End If
     If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
    RefreshRibbon.Invalidate
    End Sub
    Public Sub Combobox_getText(control As IRibbonControl, ByRef returnedVal)
            If control.id = "Combobox1" Then
            returnedVal = ComboboxText
            End If

    End Sub
    Public Sub Combobox_onChange(control As IRibbonControl, Text As String)

    ComboboxText = "AAA"

    If control.id = "Combobox1" Then
    Fnd = ""
    Fnd = "ComboboxText = " & """" & ComboboxText & """"
    Rplc = ""
    Rplc = "ComboboxText = " & """" & Text & """"
    VBRplcr "RefreshControls", Fnd, Rplc
    VBRplcr "Combobox_getText", Fnd, Rplc
    VBRplcr "Combobox_onChange", Fnd, Rplc

    ComboboxText = Text

    End If
        ''''''''''''''''''''''''''''''''''''''
     If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
    RefreshRibbon.Invalidate
    End Sub
    Public Sub Combobox_getItemCount(control As IRibbonControl, ByRef returnedVal)

             If control.id = "Combobox1" Then
             returnedVal = 6
             End If
    End Sub
    Public Sub ComboboxgetItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)

    Dim ComboItemLabel As Variant
        If control.id = "Combobox1" Then
            ComboItemLabel = Array("AAA", "BBB", "CCC", "DDD", "EEE", "FFF")

            Dim I As Long

                returnedVal = ComboItemLabel(index)
        Else

        End If

    End Sub
    Public Sub Dropdown_getItemCount(control As IRibbonControl, ByRef returnedVal)

             DropdownItemCount = 6

             If control.id = "Dropdown1" Then
             returnedVal = DropdownItemCount

             End If
    End Sub
    Public Sub Dropdown_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)

    DropdownSelectedItem = index
    returnedVal = WeekdayName(index + 1)
    End Sub
    Public Sub Dropdown_getSelectedItemIndex(control As IRibbonControl, ByRef returnedVal)

    DropdownSelectedItem = 5
    returnedVal = DropdownSelectedItem
    End Sub
    Public Sub GetAction(control As IRibbonControl, id As String, index As Integer)

        If control.id = "Dropdown1" Then
        Dropdown = "Friday"
                 DropdownSelectedItem = 5

            Fnd = "": Rplc = ""
            Fnd = "Dropdown = " & """" & Dropdown & """"
            Rplc = "Dropdown = " & """" & WeekdayName(index + 1) & """"
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "GetAction", Fnd, Rplc

            Fnd = "": Rplc = ""
            Fnd = "DropdownItemCount = " & DropdownItemCount
            Rplc = "DropdownItemCount = " & DropdownItemCount
            VBRplcr "RefreshControls", Fnd, Rplc

            Fnd = ""
            Fnd = "DropdownSelectedItem = " & DropdownSelectedItem
            Rplc = ""
            Rplc = "DropdownSelectedItem = " & index
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Dropdown_getSelectedItemIndex", Fnd, Rplc
            VBRplcr "GetAction", Fnd, Rplc
         '''''''''Your Action


        ElseIf control.id = "Dropdown2" Then

        ElseIf control.id = "Dropdown3" Then

        End If
     If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
    RefreshRibbon.Invalidate

    End Sub
    Public Sub Checkbox_getPressed(control As IRibbonControl, ByRef returnedVal)

             ChkBx(1) = True
             ChkBx(2) = True
             ChkBx(3) = True
             ChkBx(4) = False
             ChkBx(5) = True
             ChkBx(6) = False


        If control.id = "Checkbox1" Then
        returnedVal = ChkBx(1)
        ElseIf control.id = "Checkbox2" Then
        returnedVal = ChkBx(2)
        ElseIf control.id = "Checkbox3" Then
        returnedVal = ChkBx(3)

        ElseIf control.id = "Checkbox4" Then
            returnedVal = ChkBx(4)
        ElseIf control.id = "Checkbox5" Then
            returnedVal = ChkBx(5)
        ElseIf control.id = "Checkbox6" Then
            returnedVal = ChkBx(6)
        End If
    Exit Sub

    End Sub
    Public Sub Checkbox_onAction(control As IRibbonControl, pressed As Boolean)

    Fnd = "": Rplc = ""
        If control.id = "Checkbox1" Then
            Fnd = "ChkBx(1) = " & ChkBx(1)
            Rplc = "ChkBx(1) = " & pressed
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Checkbox_getPressed", Fnd, Rplc

            ChkBx(1) = pressed
       'You Action Here

        ElseIf control.id = "Checkbox2" Then
            Fnd = "ChkBx(2) = " & ChkBx(2)
            Rplc = "ChkBx(2) = " & pressed
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Checkbox_getPressed", Fnd, Rplc

            ChkBx(2) = pressed
        'You Action Here

        ElseIf control.id = "Checkbox3" Then
            Fnd = "ChkBx(3) = " & ChkBx(3)
            Rplc = "ChkBx(3) = " & pressed
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Checkbox_getPressed", Fnd, Rplc

            ChkBx(3) = pressed
        'You Action Here

        ElseIf control.id = "Checkbox4" Then
            If pressed = True Then
                ChkBx(4) = pressed
                ChkBx(5) = Not pressed
                ChkBx(6) = Not pressed
                    Fnd = "ChkBx(4) = " & Not pressed: Rplc = "ChkBx(4) = " & pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc

                    Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc

                    Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc
                    'You Action Here

            End If
        ElseIf control.id = "Checkbox5" Then
            If pressed = True Then
                ChkBx(5) = pressed
                ChkBx(4) = Not pressed
                ChkBx(6) = Not pressed

                    Fnd = "ChkBx(5) = " & Not pressed: Rplc = "ChkBx(5) = " & pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc

                    Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc

                    Fnd = "ChkBx(6) = " & pressed: Rplc = "ChkBx(6) = " & Not pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc
                    'You Action Here

            End If
        ElseIf control.id = "Checkbox6" Then
            If pressed = True Then
                ChkBx(6) = pressed
                ChkBx(4) = Not pressed
                ChkBx(5) = Not pressed

                    Fnd = "ChkBx(6) = " & Not pressed: Rplc = "ChkBx(6) = " & pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc

                    Fnd = "ChkBx(4) = " & pressed: Rplc = "ChkBx(4) = " & Not pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc

                    Fnd = "ChkBx(5) = " & pressed: Rplc = "ChkBx(5) = " & Not pressed
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Checkbox_getPressed", Fnd, Rplc
                    'You Action Here

                End If
        End If

        If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
          RefreshRibbon.Invalidate

    End Sub
    Public Sub Togglebutton_getLabel(control As IRibbonControl, ByRef returnedVal)

        Tglbtn(1) = False
        Tglbtn(2) = True
        Tglbtn(3) = False
        Tglbtn(4) = False
        Tglbtn(5) = False
        Tglbtn(6) = True

        If control.id = "Togglebutton1" Then
            If Tglbtn(1) = True Then
                returnedVal = "On"
            Else
                returnedVal = "Off"
            End If
        ElseIf control.id = "Togglebutton2" Then
            If Tglbtn(2) = True Then
                returnedVal = "On"
            Else
                returnedVal = "Off"
            End If
        ElseIf control.id = "Togglebutton3" Then
            If Tglbtn(3) = True Then
                returnedVal = "On"
            Else
                returnedVal = "Off"
            End If
        ElseIf control.id = "Togglebutton4" Then
            If Tglbtn(4) = False Then
                returnedVal = "Off"
            Else
                returnedVal = "On"
            End If
        ElseIf control.id = "Togglebutton5" Then
            If Tglbtn(5) = False Then
                returnedVal = "Off"
            Else
                returnedVal = "On"
            End If
        ElseIf control.id = "Togglebutton6" Then
            If Tglbtn(6) = False Then
                returnedVal = "Off"
            Else
                returnedVal = "On"
            End If
        End If
    End Sub

    Public Sub Togglebutton_getPressed(control As IRibbonControl, ByRef returnedVal)

        Tglbtn(1) = False
        Tglbtn(2) = True
        Tglbtn(3) = False
        Tglbtn(4) = False
        Tglbtn(5) = False
        Tglbtn(6) = True
        If control.id = "Togglebutton1" Then
        returnedVal = Tglbtn(1)
        ElseIf control.id = "Togglebutton2" Then
        returnedVal = Tglbtn(2)
        ElseIf control.id = "Togglebutton3" Then
        returnedVal = Tglbtn(3)

        ElseIf control.id = "Togglebutton4" Then
            returnedVal = Tglbtn(4)
        ElseIf control.id = "Togglebutton5" Then
            returnedVal = Tglbtn(5)
        ElseIf control.id = "Togglebutton6" Then
            returnedVal = Tglbtn(6)
        End If
    Exit Sub
    End Sub
    Public Sub Togglebutton_onAction(control As IRibbonControl, ByRef cancelDefault)

    Fnd = "": Rplc = ""
        If control.id = "Togglebutton1" Then
            Fnd = "Tglbtn(1) = " & Tglbtn(1)
            Rplc = "Tglbtn(1) = " & cancelDefault
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Togglebutton_getPressed", Fnd, Rplc
            VBRplcr "Togglebutton_getLabel", Fnd, Rplc
            Tglbtn(1) = cancelDefault
        'You Action Here


        ElseIf control.id = "Togglebutton2" Then
            Fnd = "Tglbtn(2) = " & Tglbtn(2)
            Rplc = "Tglbtn(2) = " & cancelDefault
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Togglebutton_getPressed", Fnd, Rplc
            VBRplcr "Togglebutton_getLabel", Fnd, Rplc
            Tglbtn(2) = cancelDefault
        'You Action Here


        ElseIf control.id = "Togglebutton3" Then
            Fnd = "Tglbtn(3) = " & Tglbtn(3)
            Rplc = "Tglbtn(3) = " & cancelDefault
            VBRplcr "RefreshControls", Fnd, Rplc
            VBRplcr "Togglebutton_getPressed", Fnd, Rplc
            VBRplcr "Togglebutton_getLabel", Fnd, Rplc
            Tglbtn(3) = cancelDefault
        'You Action Here


        ElseIf control.id = "Togglebutton4" Then
            If cancelDefault = True Then
                Tglbtn(4) = cancelDefault
                Tglbtn(5) = Not cancelDefault
                Tglbtn(6) = Not cancelDefault
                    Fnd = "Tglbtn(4) = " & Not cancelDefault: Rplc = "Tglbtn(4) = " & cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc

                    Fnd = "Tglbtn(5) = " & cancelDefault: Rplc = "Tglbtn(5) = " & Not cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc

                    Fnd = "Tglbtn(6) = " & cancelDefault: Rplc = "Tglbtn(6) = " & Not cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc
                    'You Action Here



            End If
        ElseIf control.id = "Togglebutton5" Then
            If cancelDefault = True Then
                Tglbtn(5) = cancelDefault
                Tglbtn(4) = Not cancelDefault
                Tglbtn(6) = Not cancelDefault

                    Fnd = "Tglbtn(5) = " & Not cancelDefault: Rplc = "Tglbtn(5) = " & cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc

                    Fnd = "Tglbtn(4) = " & cancelDefault: Rplc = "Tglbtn(4) = " & Not cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc

                    Fnd = "Tglbtn(6) = " & cancelDefault: Rplc = "Tglbtn(6) = " & Not cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc
                    'You Action Here

            End If
        ElseIf control.id = "Togglebutton6" Then
            If cancelDefault = True Then
                Tglbtn(6) = cancelDefault
                Tglbtn(4) = Not cancelDefault
                Tglbtn(5) = Not cancelDefault

                    Fnd = "Tglbtn(6) = " & Not cancelDefault: Rplc = "Tglbtn(6) = " & cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc

                    Fnd = "Tglbtn(4) = " & cancelDefault: Rplc = "Tglbtn(4) = " & Not cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc

                    Fnd = "Tglbtn(5) = " & cancelDefault: Rplc = "Tglbtn(5) = " & Not cancelDefault
                    VBRplcr "RefreshControls", Fnd, Rplc
                    VBRplcr "Togglebutton_getPressed", Fnd, Rplc
                    VBRplcr "Togglebutton_getLabel", Fnd, Rplc
                   'You Action Here

                End If
        End If
        If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
          RefreshRibbon.Invalidate

    End Sub
    Public Sub saveGlobal(Glbl As Object, GlblName As String)

        #If VBA7 Then
        Dim lngRibPtr As LongPtr
        #Else
        Dim lngRibPtr As Long
            #End If
        lngRibPtr = ObjPtr(Glbl)
        With ThisWorkbook
        On Error Resume Next
        .Names(GlblName).Delete
        On Error GoTo 0
        .Names.Add GlblName, lngRibPtr
        .Saved = True
            End With
    End Sub

    Public Function GetGlobal(GlblName As String) As Object

        #If VBA7 Then
        Dim X As LongPtr
        X = CLngPtr(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
        #Else
        Dim X As Long
        X = CLng(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
            #End If
        Dim objRibbon As Object
        CopyMemory objRibbon, X, Len(X)
        Set GetGlobal = objRibbon
    End Function
    Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)
     'Microsoft Visual Basic for Applications Extensibility 5.3 is required
    Dim VBProj As VBIDE.VBProject
    Dim VBComp As VBIDE.VBComponent
    Dim CodeMod As VBIDE.CodeModule
    Dim ThisLine As String
    Dim N As Long
    Dim ProcStrLn As Long, ProcAcStrLn As Long, ProcCntLn As Long, PrcCnountLine As Long
        Set VBProj = ThisWorkbook.VBProject
        For Each VBComp In VBProj.VBComponents
            With VBComp
                If .Type = vbext_ct_StdModule Then
                    With .CodeModule
                        If InStr(1, .Lines(1, .CountOfLines), PrcName) > 0 Then
                            On Error Resume Next
                            ProcStrLn = .ProcStartLine(PrcName, vbext_pk_Proc)
                            ProcAcStrLn = .ProcBodyLine(PrcName, vbext_pk_Proc)
                            ProcCntLn = .ProcCountLines(PrcName, vbext_pk_Proc)
                            PrcCnountLine = ProcCntLn - (ProcAcStrLn - ProcStrLn)
                            If PrcName = .ProcOfLine(ProcAcStrLn, vbext_pk_Proc) Then
                                For N = (ProcAcStrLn + 1) To (ProcAcStrLn + PrcCnountLine - 1)
                                   ThisLine = .Lines(N, 1)
                                     If InStr(1, ThisLine, Trim(Fnd), vbTextCompare) > 0 Then
                                        .ReplaceLine N, Replace(ThisLine, Fnd, Rplc, , , vbTextCompare)
                                        Exit For
                                     Exit For
                                    Exit For
                                    End If
                                Next N
                            End If
                            Exit Sub
                            Fnd = "": Rplc = ""

                            On Error GoTo 0
                        End If
                    End With
                End If
            End With
        Next
    End Sub