×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Enum String Value

Enum String Value

Enum String Value

(OP)

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 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close