Menu
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.
I also need to know if it is possible to know if this checkbox is checked or not using vba
431
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.
Ribbon XML:
<checkBox id="cbStoreValue" label="MyCheckBox" getPressed="Function_Clicked" onAction="Function_Action" />
VBA Code:
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
174
Use any Program to insert Below Custom Ribbon XML Code into Excel Book
<!--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)
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With
