Simplify this code please if you can its work will
Code:
Public Enum SecurityLevelp
IllegalEntry = 1
SecurityLVL1
SecurityLVL2 = 8
SecurityLVL3
SecurityLVL4 = 10
SecurityLVL5
SecurityLVL6 = 15
End Enum
Public Sub Test()
AddRef ThisWorkbook, "{0002E157-0000-0000-C000-000000000046}", "VBIDE", 5, 3 'if need or delete this line. To select required Reference
MsgBox GeEnumValues("SecurityLevelp", 1) 'to replace enum
MsgBox GeEnumValues("SecurityLevelp", SecurityLVL3) 'to replace enum
MsgBox GeEnumValues("SecurityLevelp", 11) 'to replace enum
MsgBox GeEnumValues("SecurityLevelp", SecurityLVL6) 'to replace enum
End Sub
Function GeEnumValues(PrcName As String, EnumItm As Long)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'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, ThisSub As String, Itm As String
Dim DecItm As Variant
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
' ThisLine = .Lines(N, 1)
' If InStr(N, ThisLine, Fnd, vbTextCompare) > 0 Then
'ThisSub = ThisSub & vbNewLine & ThisLine
'End If
'Next
' End If
Else '____________________________________________________________________________________________________
' Replce Declaration such as Enum
For D = 1 To .CountOfDeclarationLines
ThisLine = .Lines(D, 1)
If InStr(1, ThisLine, "Enum " & PrcName) > 0 Then
Titl = DecItm(D)
Dec = Dec & vbNewLine & ThisLine: DecStrLn = D
S = InStr(1, ThisLine, "Enum " & PrcName) + Len("Enum " & PrcName) 'Start replace column
ElseIf InStr(1, Dec, "Enum " & PrcName) > 0 And InStr(1, ThisLine, "End Enum") > 0 Then
Dec = Dec & vbNewLine & ThisLine: DecEndLn = D
Exit For
ElseIf InStr(1, Dec, "Enum " & PrcName) Then
Dec = Dec & vbNewLine & ThisLine
End If
Next 'Declaration
' 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
'Declaration
DecItm = Split(Dec, vbNewLine)
For D = LBound(DecItm) To UBound(DecItm)
Itm = DecItm(D)
If Itm <> "" And InStr(1, Itm, "Enum " & PrcName, vbTextCompare) = 0 And InStr(1, Itm, "End Enum") = 0 Then
If InStr(1, Itm, " = ", vbTextCompare) > 0 Then
N = Split(Itm, " = ")(1)
Else
Itm = Itm & " = " & N
End If
If EnumItm = N Then
GeEnumValues = Trim(Split(Itm, " = ")(0))
Exit Function
End If
N = N + 1
End If
Next
End Function
' if needed o delte below code
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