Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Enum String Value

Status
Not open for further replies.

DossFM

Technical User
Feb 10, 2018
1
0
0
SA

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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top