this to save and maintain Custom Ribbon Controls Values for next use, it works but need some edit from professional to find Why CheckBox1 or Toggle Button1 not respond for initial click From True to False Press after using EditBox, ComboBox or DropDown
Please Use Custom UI Editor to insert the RibbonX code below and Replace "< " with "<" to eliminate Space after < press (Ctrl + H) for replacing
Into Normal Module Paste Below Codes
Thanks
<link rel="icon" href="<a href=" https:="" p.sfx.ms="" images="" favicon.ico"="" target="_blank">
Please Use Custom UI Editor to insert the RibbonX code below and Replace "< " with "<" to eliminate Space after < press (Ctrl + H) for replacing
Code:
[COLOR=#0000ff]< [/COLOR]!--RibbonX Visual Designer (64-bit) 2.44 for Microsoft Excel CustomUI14 . XML Code produced on 2018/06/02-->
[B][COLOR=#0000ff]< [/COLOR][/B]customUI
xmlns="http://schemas.microsoft.com/office/2009/07/customui"
******="RefreshControls">
[B][COLOR=#0000ff]< [/COLOR][/B]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 >Into Normal Module Paste Below Codes
Code:
Option Explicit
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal length As Long)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] 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)
'
' Code for ****** callback. Ribbon control customUI
'
Set RefreshRibbon = ribbon ' Set Ribbon ******
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 = "Night" ' EditboxText1 ' Text value
''''''''''''''''''''''''
ComboboxText = "AAA" ' Combobox1 Text value
ComboItemCount = 6 ' Combobox1 Itmes Count
'''''''''''''''''''''''''
Dropdown = "Sunday" ' Dropdown1 Text value
DropdownItemCount = 6 ' Dropdown1 Itmes Count
DropdownSelectedItem = 0 ' Dropdown1 Itme Number
'''''''''''''''''''''''
ChkBx(1) = True 'Free select (1 to 3)
ChkBx(2) = True
ChkBx(3) = True
''''''''''''''''''''''''
ChkBx(4) = True 'One selected Option From Group select (4 to 6)
ChkBx(5) = False
ChkBx(6) = False
Tglbtn(1) = False 'Free select (1 to 3)
Tglbtn(2) = True
Tglbtn(3) = True
'''''''''''''''''''''''
Tglbtn(4) = True 'One selected Option From Group select (4 to 6)
Tglbtn(5) = False
Tglbtn(6) = False
End Sub
Public Sub Editbox_getText(control As IRibbonControl, ByRef returnedVal)
'
' Code for getText callback. Ribbon control editBox
'
If control.id = "Editbox1" Then
returnedVal = EditboxText
End If
End Sub
Public Sub Editbox_onChange(control As IRibbonControl, Text As String)
'
' Code for onChange callback. Ribbon control editBox
'
' to save control Value
'RefreshControls RefreshRibbon
EditboxText = "Night"
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
''''''''''''''''''''''''''''''''''''''''
'On Error Resume Next
If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
RefreshRibbon.InvalidateControl ("Editbox1")
'On Error GoTo 0
End Sub
Public Sub Combobox_getText(control As IRibbonControl, ByRef returnedVal)
'
' Code for getText callback. Ribbon control comboBox
'
'ComboboxText = "AAA"
If control.id = "Combobox1" Then
returnedVal = ComboboxText
End If
End Sub
Sub ff()
End Sub
Public Sub Combobox_onChange(control As IRibbonControl, Text As String)
'
' Code for onChange callback. Ribbon control comboBox
'RefreshControls RefreshRibbon
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.InvalidateControl ("Combobox1")
End Sub
Public Sub Combobox_getItemCount(control As IRibbonControl, ByRef returnedVal)
'
' Code for getItemCount callback. Ribbon control comboBox
'
' ComboItemCount = 6
If control.id = "Combobox1" Then
returnedVal = 6
' ElseIf control.id = "Combobox2" Then
'returnedVal = 10
' ElseIf control.id = "Combobox2" Then
'returnedVal = 4
End If
End Sub
Public Sub ComboboxgetItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
'
' Code for getItemLabel callback. Ribbon control comboBox
'
Dim ComboItemLabel As Variant
''RefreshControls RefreshRibbon
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)
'
' Code for getItemCount callback. Ribbon control dropDown
'
DropdownItemCount = 6
If control.id = "Dropdown1" Then
returnedVal = DropdownItemCount
' ElseIf control.id = "Dropdown2" Then
'returnedVal = 10
' ElseIf control.id = "Dropdown2" Then
'returnedVal = 4
End If
End Sub
Public Sub Dropdown_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
'
' Code for getItemLabel callback. Ribbon control dropDown
'
DropdownSelectedItem = index
returnedVal = WeekdayName(index + 1)
End Sub
Public Sub Dropdown_getSelectedItemIndex(control As IRibbonControl, ByRef returnedVal)
'
' Code for getSelectedItemIndex callback. Ribbon control dropDown
'
DropdownSelectedItem = 0
returnedVal = DropdownSelectedItem
End Sub
Public Sub GetAction(control As IRibbonControl, id As String, index As Integer)
'
' Code for onAction callback. Ribbon control dropDown
'
'RefreshControls RefreshRibbon
If control.id = "Dropdown1" Then
Dropdown = "Sunday"
DropdownSelectedItem = 0
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.InvalidateControl ("Dropdown1")
End Sub
Public Sub Checkbox_getPressed(control As IRibbonControl, ByRef returnedVal)
'
' Code for getPressed callback. Ribbon control checkBox
ChkBx(1) = True
ChkBx(2) = True
ChkBx(3) = True
ChkBx(4) = True
ChkBx(5) = False
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)
'
' Code for onAction callback. Ribbon control checkBox
'
'RefreshControls RefreshRibbon
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
'''''' Write what you need from "Checkbox1" Below V
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
'''''' Write what you need from "Checkbox2" Below V
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
'''''' Write what you need from "Checkbox3" Below V
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
'''''' Write what you need from "Checkbox4" Below V
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
'''''' Write what you need from "Checkbox5" Below V
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
'''''' Write what you need from "Checkbox6" Below V
End If
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'On Error Resume Next
If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
RefreshRibbon.InvalidateControl "Checkbox1"
RefreshRibbon.InvalidateControl "Checkbox2"
RefreshRibbon.InvalidateControl "Checkbox3"
RefreshRibbon.InvalidateControl "Checkbox4"
RefreshRibbon.InvalidateControl "Checkbox5"
RefreshRibbon.InvalidateControl "Checkbox6"
' On Error GoTo 0
End Sub
Public Sub Togglebutton_getLabel(control As IRibbonControl, ByRef returnedVal)
'
' Code for getLabel callback. Ribbon control toggleButton
'
Tglbtn(1) = False
Tglbtn(2) = True
Tglbtn(3) = True
Tglbtn(4) = True
Tglbtn(5) = False
Tglbtn(6) = False
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)
'
' Code for getPressed callback. Ribbon control toggleButton
'
Tglbtn(1) = False
Tglbtn(2) = True
Tglbtn(3) = True
Tglbtn(4) = True
Tglbtn(5) = False
Tglbtn(6) = False
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)
'
' Code for onAction callback. Ribbon control toggleButton
'
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
'''''' Write what you need from "Togglebutton1" Below V
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
'''''' Write what you need from "Togglebutton2" Below V
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
'''''' Write what you need from "Togglebutton3" Below V
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
'''''' Write what you need from "Togglebutton4" Below V
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
'''''' Write what you need from "Togglebutton5" Below V
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
'''''' Write what you need from "Togglebutton6" Below V
End If
End If
''''''''''''''''''''''''''''''
'On Error Resume Next
If RefreshRibbon Is Nothing Then Set RefreshRibbon = GetGlobal("RibbonPtr")
RefreshRibbon.InvalidateControl "Togglebutton1"
RefreshRibbon.InvalidateControl "Togglebutton2"
RefreshRibbon.InvalidateControl "Togglebutton3"
RefreshRibbon.InvalidateControl "Togglebutton4"
RefreshRibbon.InvalidateControl "Togglebutton5"
RefreshRibbon.InvalidateControl "Togglebutton6"
' RefreshRibbon.InvalidateControl control.id
' On Error GoTo 0
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' To refresh Ribbon Control after faults
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub saveGlobal(Glbl As Object, GlblName As String)
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Dim lngRibPtr As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Dim lngRibPtr As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] 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
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Dim X As LongPtr
X = CLngPtr(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Dim X As Long
X = CLng(Mid(ThisWorkbook.Names(GlblName).RefersTo, 2))
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Dim objRibbon As Object
CopyMemory objRibbon, X, Len(X)
Set GetGlobal = objRibbon
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' to Save Ribbon Control
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 ' Withen Standr Module
With .CodeModule
If InStr(1, .Lines(1, .CountOfLines), PrcName) > 0 Then
On Error Resume Next
ProcStrLn = .ProcStartLine(PrcName, vbext_pk_Proc) ' Procedure Start Line
ProcAcStrLn = .ProcBodyLine(PrcName, vbext_pk_Proc) ' Actually Procedure Start Line
ProcCntLn = .ProcCountLines(PrcName, vbext_pk_Proc)
PrcCnountLine = ProcCntLn - (ProcAcStrLn - ProcStrLn)
If PrcName = .ProcOfLine(ProcAcStrLn, vbext_pk_Proc) Then 'Get Proce Name
For N = (ProcAcStrLn + 1) To (ProcAcStrLn + PrcCnountLine - 1) ' Add 1 to avoid chane Procedure Name and -1 to avoid replace Next Procedure
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 '''' If PrcName = .ProcOfLine
Exit Sub ''''''''''''''''''''''''''''''''Job Completed
Fnd = "": Rplc = ""
On Error GoTo 0
End If '''If InStr(1, .Lines(1, .CountOfLines), PrcName) > 0 Then
End With ' .CodeModule
End If ' .Type
End With ' VBComp
Next ' In VBProj.VBComponents
End SubThanks
<link rel="icon" href="<a href=" https:="" p.sfx.ms="" images="" favicon.ico"="" target="_blank">
