VBReplace Procedure and Enum

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
Good day All
Code below handle only procedure, how to use it replace Enum string "Level" "LVL" ?

THX.

Code:
Option Explicit
[COLOR=#b22222]Public Enum SecurityLevelp[/COLOR]
IllegalEntry = 0
Security[COLOR=#0000ff][B]Level[/B]1[/COLOR] = 1
Security[B][COLOR=#0000ff]Level[/COLOR][/B]2 = 8
Security[B][COLOR=#0000ff]Level[/COLOR][/B]3
Security[COLOR=#0000ff]Level[/COLOR]4 = 10
[COLOR=#b22222]End Enum[/COLOR]


[B][COLOR=#006400]Public Sub SecurityLevel()[/COLOR][/B]
Cells.Clear
[A1] = "Security[B][COLOR=#0000ff]Level[/COLOR][/B]"
[A2] = "Security[B][COLOR=#0000ff]Level[/COLOR][/B]2" 'Level
[B][COLOR=#008000]End Sub 'Level[/COLOR][/B]
[COLOR=#ff0000][B]Public Sub Test1()[/B][/COLOR]
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3
Call VBRplcr("SecurityLevelp", [COLOR=#0000ff]"[B]LVL[/B][/COLOR]", "[B][COLOR=#0000ff]Level[/COLOR][/B]") 'to replace enum
Call VBRplcr("SecurityLevel", "[COLOR=#0000ff][B]LVL[/B][/COLOR]", "[B][COLOR=#0000ff]Level[/COLOR][/B]")
[B][COLOR=#ff0000]End Sub[/COLOR][/B]
[B][COLOR=#ff0000]Public Sub Test2()[/COLOR][/B]
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3
Call VBRplcr("SecurityLevelp", "[B][COLOR=#0000ff]Level[/COLOR][/B]", "[B][COLOR=#0000ff]LVL[/COLOR][/B]")  'to replace enum
Call VBRplcr("SecurityLevel", "[COLOR=#0000ff][B]Level[/B][/COLOR]", "[COLOR=#0000ff][B]LVL[/B][/COLOR]")
[B][COLOR=#ff0000]End Sub[/COLOR][/B]
Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)


Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim ProcStrLn As Long, ProcAcStrLn As Long, ProcCntLn As Long, N 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
                             MsgBox .Lines(N, 1)
                                If InStr(N, .Lines(N, 1), Fnd, vbTextCompare) > 0 Then
                                    .ReplaceLine N, Replace(.Lines(N, 1), Fnd, Rplc, 1, , vbTextCompare) 'replace
                                End If
                            Next
                        End If
                        On Error GoTo 0
                    End If
                End With ' .CodeModule
            End If ' .Type
        End With ' VBComp
    Next ' In VBProj.VBComponents
End Sub
Sub AddReferenceVBA()
    AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3
End Sub


Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String, sRefMajor As Long, sRefMinor As Long)
    Dim i As Integer
    On Error GoTo EH
    With wbk.VBProject.References
        For i = 1 To .Count
            If .Item(i).Name = sRefName Then
               Exit For
            End If
        Next i
        If i > .Count Then
        
           .AddFromGuid sGuid, sRefMajor, sRefMinor ' 0,0 should pick the latest version installed on the computer
        End If
    End With
EX: Exit Sub
EH: MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
    Resume EX
    Resume ' debug code
    ThisWorkbook.Save
End Sub
 
Last edited:

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
I have a solution highlighted with Green color
To Replace VBA specific Procures such as Sub ....() , Function and Declaration such as enum
Code:
Option Explicit 
 
Public Enum SecurityLevelp
IllegalEntry = 0
SecurityLevel1 = 1
SecurityLevel2 = 8
SecurityLevel3
SecurityLevel4 = 10


End Enum
Public Sub SecurityLevel()
Cells.Clear
[A1] = "SecurityLevel"
[A2] = "SecurityLevel2" 'Level
End Sub 'Level
Public Sub Test1()
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3 ' To select required Reference
Call VBRplcr("SecurityLevelp", "LVL", "Level") 'to replace enum
Call VBRplcr("SecurityLevel", "LVL", "Level") 'to replace Sub
End Sub
Public Sub Test2()
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3 ' To select required Reference
Call VBRplcr("SecurityLevelp", "Level", "LVL")  'to replace enum
Call VBRplcr("SecurityLevel", "Level", "LVL") 'to replace Sub
End Sub
Sub VBRplcr(PrcName As String, Fnd As String, Rplc As String)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Reference:Microsoft Visual Basic for Extensibility 5.3 is required'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim ProcStrLn As Long, ProcAcStrLn As Long, ProcCntLn As Long, N As Long, D As Long, S As Long, PrcCnountLine As Long
Dim DecStrLn As Long, DecEndLn As Long
Dim ThisLine As String, Dec As String
    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 'Replace Sub Function
                        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 ProcAcStrLn > 0 Then
                            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
                                 MsgBox .Lines(N, 1)
                                    If InStr(N, .Lines(N, 1), Fnd, vbTextCompare) > 0 Then
                                        .ReplaceLine N, Replace(.Lines(N, 1), Fnd, Rplc, 1, , vbTextCompare) 'replace
                                    End If
                                Next
                            End If
                        Else '____________________________________________________________________________________________________
 [COLOR=#008000]                       ' Replce Declaration such as Enum
                        For D = 1 To .CountOfDeclarationLines
                                ThisLine = .Lines(D, 1)
                                If InStr(1, ThisLine, "Enum " & PrcName) > 0 Then
                                    Dec = Dec & vbNewLine & ThisLine: DecStrLn = D
                                     S = InStr(1, ThisLine, "Enum " & PrcName) + Len("Enum " & PrcName) 'Start replace column
                                    .ReplaceLine D, Left(.Lines(D, 1), S) & Replace(.Lines(D, 1), Fnd, Rplc, S + 1, , vbTextCompare) 'replace
                                ElseIf InStr(1, Dec, "Enum " & PrcName) > 0 And InStr(1, ThisLine, "End Enum") > 0 Then
                                    Dec = Dec & vbNewLine & ThisLine: DecEndLn = D
                                    .ReplaceLine D, Replace(.Lines(D, 1), Fnd, Rplc, 1, , vbTextCompare) 'replace
                                    Exit For
                                ElseIf InStr(1, Dec, "Enum " & PrcName) Then
                                    Dec = Dec & vbNewLine & ThisLine
                                    .ReplaceLine D, Replace(.Lines(D, 1), Fnd, Rplc, 1, , vbTextCompare) 'replace
                                End If
                        Next 'Declaration
[/COLOR]                        ' MsgBox .Lines(DecStrLn, DecEndLn - DecStrLn + 1) '=MsgBox Dec 'Declaration
                        End If '_______________________________________________________________________________________________________
                        On Error GoTo 0
                    End If
                End With ' .CodeModule
            End If ' .Type
        End With ' VBComp
    Next ' In VBProj.VBComponents
    'MsgBox Dec 'Declaration
End Sub
Sub AddReferenceVBA()
    AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3
End Sub




Sub AddRef(wbk As Workbook, sGuid As String, sRefName As String, sRefMajor As Long, sRefMinor As Long)
    Dim i As Integer
    On Error GoTo EH
    With wbk.VBProject.References
        For i = 1 To .Count
            If .Item(i).Name = sRefName Then
               Exit For
            End If
        Next i
        If i > .Count Then
        
           .AddFromGuid sGuid, sRefMajor, sRefMinor ' 0,0 should pick the latest version installed on the computer
        End If
    End With
EX: Exit Sub
EH: MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
    Resume EX
    Resume ' debug code
    ThisWorkbook.Save
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top