4

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

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

4

2 回答 2

9

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

功能区 XML:

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

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

希望这可以帮助 :)

维卡斯 B

于 2013-07-02T18:38:06.843 回答
4

使用任何程序将自定义功能区 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 >

然后在代码下方插入普通模块

您可以将复选框和其他控件值存储在应用程序中,并使用此函数 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
于 2018-06-03T22:28:40.893 回答