excel_version_of_some_stackoverflow_access_code

gistfile1.txt

Public Enum CodeInfoEnum
    ciEnums
    ciConstants
End Enum


'---------------------------------------------------------------------------------------
' Procedure     : CodeInfo
'
' Author        : RMittelman@gmail.com
'
' Purpose       : Searches a module for enumerations & constants
'
' History       :   11/13/2022  Original version
'                   11/14/2022  Added feature to list enums in the module
'                   11/14/2022  Added feature to list constants inn the module
'
' Parameters    :
'
'   CodeType    : A CodeInfoEnum member indicating Enums or Constants
'
'   ModuleName  : Optional. Name of module containing ItemName
'                   If missing, defaults to the module this function is called from
'
'   ItemName    : Optional. Name of the enumeration to examine
'                   If "?" or missing, returns a list of enumerations in the module
'
'   EnumValue   : optional. Value of the enumeration member wanted
'                   If missing, defaults to 0
'                   Ignored if CodType is not ciEnums
'                   Ignored if ItemName is missing or "?"
'
' Returns       : - The text value of the enumeration value supplied; or
'                 - A list of enumeration names in the module; or
'                 - A list of constant names in the module
'
' Notes         : Only searches in the module's Declarations section
'
'---------------------------------------------------------------------------------------
'
Public Function CodeInfo(CodeType As CodeInfoEnum, Optional ModuleName As Variant, Optional ItemName As String = "?", Optional EnumValueWanted As Variant) As String

    Dim myApp       As Excel.Application
    Dim compMod     As Object
    
    Dim modLines    As Long
    Dim procStart   As Long
    Dim procLines   As Long
    Dim idx         As Long
    Dim codeText    As String
    Dim foundItem   As Boolean
    Dim foundMember As Boolean
    Dim tempVal     As Variant
    Dim enumVal     As Long
    
    CodeInfo = ""
    Set myApp = ThisWorkbook.Application
    
    If IsMissing(ModuleName) Then ModuleName = Application.VBE.ActiveCodePane.CodeModule
    If ModuleName <> "" Then
    
        Set compMod = myApp.VBE.ActiveVBProject.VBComponents(ModuleName).CodeModule
        With compMod
        
            ' get declaration code
            modLines = .CountOfLines
            procStart = 1
            procLines = .CountOfDeclarationLines
        
            ' search code text for enumeration(s)
            idx = 0
            foundItem = False
            Do While (Not foundItem) And (idx <= procLines)
            
                idx = idx + 1
                codeText = .Lines(idx, 1)
            
                ' if ItemName is "?", build list of all desired items
                If ItemName = "?" Then
                    Select Case CodeType
                        Case CodeInfoEnum.ciEnums
                            If codeText Like "*Enum *" Then
                                tempVal = Trim$(Mid$(codeText, InStr(1, codeText, "Enum", vbTextCompare) + 4))
                                CodeInfo = CodeInfo & "," & tempVal
                            End If
                        Case CodeInfoEnum.ciConstants
                            If codeText Like "*Const *" Then
                                tempVal = Mid$(codeText, InStr(1, codeText, "Const", vbTextCompare) + 6)
                                tempVal = Trim$(Left$(tempVal, InStr(1, tempVal, " ")))
                                CodeInfo = CodeInfo & "," & tempVal
                            End If
                    End Select
            
                ' otherwise, just see if we can find ItemName wanted
                Else
                    foundItem = codeText Like "*Enum " & ItemName
                End If
            
            Loop
        
            ' if a specific Enum is found, look for the value wanted
            If foundItem Then
                enumVal = 0
                foundMember = False
                codeText = ""
                Do While (Not foundMember) And (idx <= procLines) And (Not codeText Like "*End Enum")
                    idx = idx + 1
                    codeText = .Lines(idx, 1)
                    If codeText Like "*=*" Then
                        tempVal = Trim$(Split(codeText, "=")(1))
                        If IsNumeric(tempVal) Then enumVal = CLng(tempVal)
                    End If
                    If enumVal = EnumValueWanted Then
                        CodeInfo = Trim$(Split(codeText, "=")(0))
                        foundMember = True
                    End If
                    enumVal = enumVal + 1
                Loop
            End If
        
        End With
        If CodeInfo Like ",*" Then CodeInfo = Mid$(CodeInfo, 2)
    
    End If

    Set compMod = Nothing
    Set myApp = Nothing

End Function