Excel VBA - 设置枚举元素的值

Excel VBA - Set values of Enumerated elements

提问by cheezsteak

In a Class Module there is

在类模块中有

Private Enum colType
    ID = "A"
    SSN = "B"
    lName = "H"
    fName = "G"
End Enum

as a private member. Whenever the class initializes I get the Compile Error: Type Mismatchmessage. If I declare colTypeas Private Enum coltype As String. That gets highlighted red as an error and I get the Compile Error: Expected end of statementmessage.

作为私人会员。每当类初始化时，我都会收到 编译错误：类型不匹配消息。如果我声明colType为Private Enum coltype As String. 这作为错误突出显示为红色，我收到编译错误：预期的语句结束消息。

Is specifying the values of enumerated elements Unallowed in excel VBA?

在 Excel VBA 中是否不允许指定枚举元素的值？

采纳答案by ex-man

As written in the comments, this is not possible. There is possible workaround though that I used in the past. Have:

正如评论中所写，这是不可能的。尽管我过去使用过，但有可能的解决方法。有：

Private Enum colType
  ID = 1
  SSN = 2
  lName = 3
  fName = 4
End Enum

And then create a separate String property of function such as:

然后创建一个单独的函数的 String 属性，例如：

Public Property Get colType_String(colType) as String
  Dim v as Variant
  v= Array("A","B", ...)
  colType_String = vba.cstr(v(colType))
End Property

This is not the most universal solution, but it is easy to implement and it does the job... If you have this in the class module already you can even use property on private colType variable and there is no need to have colType input into the property.

这不是最通用的解决方案，但它很容易实现并且可以完成工作......如果您已经在类模块中拥有它，您甚至可以在私有 colType 变量上使用属性，并且不需要将 colType 输入到财产。

回答by Rich Harding

I quite like ex-man's solution in certain circumstances, for which reason I've upvoted it. The solution more often posited goes along the following lines:

在某些情况下，我非常喜欢前人的解决方案，因此我对它投了赞成票。更经常提出的解决方案遵循以下几行：

Enum myEnum
  myName1 = 1
  myName2 = 2
  myName3 = 3
End Enum

Function getEnumName(eValue As myEnum)
  Select Case eValue
  Case 1
    getEnumName = "myName1"
  Case 2
    getEnumName = "myName2"
  Case 3
    getEnumName = "myName3"
  End Select
End Function

Debug.Print getEnumName(2) prints "myName2"

Debug.Print getEnumName(2) prints "myName2"

回答by Stuart Emmett

I have been searching for a very long time for the answer to this question. I do not want to have to relist the contents of an Enum in either a Case statement or an array. I couldn't find the answer, but I have managed to do after finding the code somewhere to change Module content. An alteration of that has produced the following working code, to be placed in Module1:

我一直在寻找这个问题的答案很长一段时间。我不想在 Case 语句或数组中重新列出 Enum 的内容。我找不到答案，但在某处找到更改模块内容的代码后，我设法做到了。对它的更改产生了以下工作代码，放置在模块 1 中：

    Option Explicit

    Enum MensNames
        Fred
        Trev = 5
        Steve
        Bill = 27
        Colin
        Andy
    End Enum

    Sub EnumStringTest()
        MsgBox EnumString(Steve) & " = " & Steve
    End Sub

    Function EnumString(EnumElement As MensNames) As String
        Dim iLineNo As Integer
        Dim iElementNo As Integer

        iElementNo = 0
        EnumString = vbNullString
        With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
            ' Find the Enum Start
            For iLineNo = 1 To .CountOfLines
                If InStr(.Lines(iLineNo, 1), "Enum MensNames") > 0 Then
                    Exit For
                End If
            Next iLineNo

            ' Find the required Element
            iLineNo = iLineNo + 1
            Do While InStr(.Lines(iLineNo, 1), "End Enum") = 0 And .Lines(iLineNo, 1) <> ""
                If InStr(2, .Lines(iLineNo, 1), "=") > 0 Then
                    iElementNo = CLng(Mid(.Lines(iLineNo, 1), InStr(2, .Lines(iLineNo, 1), "=") + 1))
                End If
                If iElementNo = EnumElement Then
                    EnumString = Left(Trim(.Lines(iLineNo, 1)), IIf(InStr(1, Trim(.Lines(iLineNo, 1)), " ") = 0, 1000, InStr(1, Trim(.Lines(iLineNo, 1)), " ") - 1))
                    Exit Do
                End If
                iElementNo = iElementNo + 1
                iLineNo = iLineNo + 1
            Loop
        End With
    End Function

回答by sir KitKat

To improve the solution of Rich Harding, I use the enum to improve on readability and make it less prone to mistakes:

为了改进 Rich Harding 的解决方案，我使用枚举来提高可读性并使其不易出错：

Enum myEnum
    myName
    someOtherName
    lastName
End Enum

Function getEnumName(eValue As myEnum) As String
    Select Case eValue
        Case myName:        getEnumName = "myName"
        Case someOtherName: getEnumName = "someOtherName"
        Case lastName:      getEnumName = "lastName"
    End Select
End Function

回答by Will

The long integers in the Enum could be Base-10 encodings. The ToAlpha function below converts the number to Base-26, represented with uppercase alphabet characters. To get the number, call the ToLong function with a string.

Enum 中的长整数可以是 Base-10 编码。下面的 ToAlpha 函数将数字转换为 Base-26，用大写字母字符表示。要获取数字，请使用字符串调用 ToLong 函数。

This would work up to 6 characters (anything above 2,147,483,647 overflows the Enum value).

这最多可以使用 6 个字符（超过 2,147,483,647 的任何字符都会溢出 Enum 值）。

Private Enum colType
  ID = 0 'A
  SSN = 1 'B
  lName = 7 'H
  fName = 6 'G
  WORD = 414859
  FXSHRXX = 2147483647 'Maximum long
End Enum

Sub test()
  Debug.Print "ID: " & ToAlpha(colType.ID)
  Debug.Print "SSN: " & ToAlpha(colType.SSN)
  Debug.Print "lName: " & ToAlpha(colType.lName)
  Debug.Print "fName: " & ToAlpha(colType.fName)
  Debug.Print "WORD: " & ToAlpha(colType.WORD)
  Debug.Print "FXHRXX: " & ToAlpha(colType.FXSHRXX)
End Sub

Function ToAlpha(ByVal n)
  If n < 0 Or Int(n) <> n Then Exit Function 'whole numbers only
  Do While n > 25
      ToAlpha = Chr(n Mod 26 + 65) & ToAlpha
      n = n \ 26 - 1 'base 26
  Loop
  ToAlpha = Chr(n + 65) & ToAlpha
End Function

Function ToLong(ByVal s)
  s = UCase(s)
  Dim iC
  For i = 1 To Len(s)
    iC = Asc(Mid(s, i, 1))
    If iC < 65 Or iC > 90 Then 'A-Z only
      ToLong = -1
      Exit Function
    End If
    ToLong = ToLong * 26 + (iC - 64) 'base 26
  Next
  ToLong = ToLong - 1
End Function

回答by Unhandled Exception

My solution of this looks like this:

我对此的解决方案如下所示：

Private Enum ColType
    ID = 1
    SSN = 2
    lName = 3
    fName = 4
End Enum

Private Function GetEnumName(ByVal value As ColType)
    GetEnumName = Choose(value, _
        "A", _
        "B", _
        "H", _
        "G" _
        )
End Function

Using Chooselooks more tidy.

使用Choose看起来更整洁。

Sample usage: ... = GetEnumName(ColType.ID)

示例用法： ... = GetEnumName(ColType.ID)

回答by Fahad Al-Dossary

I hope this help

我希望这有帮助

Reference: (Microsoft Visual Basic for Application Extensibility 5.3) is required

参考：（Microsoft Visual Basic for Application Extensibility 5.3）是必需的

Public Enum SecurityLevel
    IllegalEntry = 0
    SecurityLevel1 = 1
    SecurityLevel2 = 3
    SecurityLevel3
    SecurityLevel4 = 10
End Enum
Public Sub Test1()
    Cells.Clear
    Range("A1").Value = StrEnumVal("SecurityLevel", SecurityLevel.IllegalEntry)
    Range("A2").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel1)
    Range("A3").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel2)
    Range("A4").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel3)
    Range("A5").Value = StrEnumVal("SecurityLevel", SecurityLevel.SecurityLevel4)
End Sub
Public Sub AaaTest2()
    Cells.Clear
    Dim E As Long
    For E = SecurityLevel.IllegalEntry To SecurityLevel.SecurityLevel4
    Cells(E + 1, 1) = StrEnumVal("SecurityLevel", E)
    Next
End Sub
Function StrEnumVal(BEnumName As String, EnumItm As Long) As String
    '''''''''''''''''''''''''
    ' Fahad Mubark ALDOSSARY'
    '''''''''''''''''''''''''
        Dim vbcomp As VBComponent
        Dim modules As Collection
        Dim CodeMod As VBIDE.CodeModule
        Dim numLines As Long ' end line
        Dim MdlNm As String
        Dim lineNum As Long
        Dim thisLine As String, SpltEnm As String, EnumITems As String, Itm As String
        Dim EEnumName As String
        Dim Indx As Long
        Dim I As Long, s As Long
        Dim SpltEI As Variant
        Indx = 0
        Set modules = New Collection
        BEnumName = "Enum " & BEnumName
        EEnumName = "End Enum"
        For Each vbcomp In ThisWorkbook.VBProject.VBComponents

            'if normal or class module
            If vbcomp.Type = vbext_ct_StdModule Then
            Set CodeMod = vbcomp.CodeModule
                With CodeMod
                    numLines = .CountOfLines
                        For lineNum = 1 To numLines
                            thisLine = .Lines(lineNum, 1)

                                If InStr(1, thisLine, BEnumName, vbTextCompare) > 0 Then

                                    If InStr(thisLine, ":") > 0 Then
                                   ' thisLine = Replace(thisLine, BEnumName & ":", "") ' Remove Enum Titel Enum
                                    thisLine = Right(thisLine, Len(thisLine) - InStr(1, thisLine, ":"))
                                        For s = 0 To UBound(Split(thisLine, ":"))
                                            SpltEnm = Split(thisLine, ":")(s)
                                            If InStr(SpltEnm, " = ") > 0 Then
                                            Itm = SpltEnm
                                            Indx = CDbl(Split(SpltEnm, " = ")(1))
                                            Else
                                            Itm = SpltEnm & " = " & Indx
                                            End If
                                            EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm    '''''
                                            Indx = Indx + 1
                                        Next
                                        If InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then
                                         EnumITems = Replace(EnumITems, "End Enum", "")
                                        Exit For
                                        End If
                                    Else
                                    'Only Title show if nothing bedside
                                    End If
                                ElseIf InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then
                                    If InStr(thisLine, ":") > 0 Then
                                        For s = 0 To UBound(Split(thisLine, ":"))
                                            SpltEnm = Split(thisLine, ":")(s)
                                            If InStr(SpltEnm, " = ") > 0 Then
                                            Itm = SpltEnm
                                            Indx = CDbl(Split(SpltEnm, " = ")(1))
                                            Else
                                            Itm = SpltEnm & " = " & Indx
                                            End If
                                            EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm    '''''
                                            EnumITems = Replace(EnumITems, "End Enum", "")

                                            Indx = Indx + 1
                                        Next
                                    Else
                                    End If
                                Exit For
                                Else

                                    If InStr(thisLine, ":") > 0 Then
                                        For s = 0 To UBound(Split(thisLine, ":"))
                                            SpltEnm = Split(thisLine, ":")(s)

                                            If InStr(SpltEnm, " = ") > 0 Then
                                            Itm = SpltEnm
                                            Indx = CDbl(Split(SpltEnm, " = ")(1))
                                            Else
                                            Itm = SpltEnm & " = " & Indx
                                            End If
                                        EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm    '''''
                                        Indx = Indx + 1
                                        Next
                                    Else

                                        If InStr(thisLine, " = ") > 0 Then
                                        Itm = thisLine
                                        Indx = Split(thisLine, " = ")(1)
                                        Else
                                        Itm = thisLine & " = " & Indx
                                        End If
                                        EnumITems = EnumITems & IIf(EnumITems <> "", vbNewLine, "") & Itm '''''
                                    End If
                                    Indx = Indx + 1
                                End If

                        Next lineNum
                    If InStr(1, thisLine, EEnumName, vbTextCompare) > 0 Then Exit For
                End With 'CodeMod
            End If
        Next vbcomp

        SpltEI = Split(EnumITems, vbNewLine)
        For I = LBound(SpltEI) To UBound(SpltEI)
             If CDbl(Replace(Split(SpltEI(I), " = ")(1), " ", "")) = EnumItm Then
             StrEnumVal = Replace(Split(SpltEI(I), " = ")(0), " ", "")
             Exit For
             Else
             End If
        Next

End Function

To active Required Reference copy Below Code then delete it

要激活必需的参考副本下面的代码然后将其删除

enter image description here

在此处输入图片说明

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
                ThisWorkbook.Save
            End If
        End With
EX:    Exit Sub
EH:         MsgBox "Error in 'AddRef'" & vbCrLf & vbCrLf & Err.Description
        Resume EX
        Resume ' debug code
End Sub

回答by Fahad Al-Dossary

Updated and corrcted

更新和更正

        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

回答by Harry

Instead of Enum, define a Type(struct)

定义一个 Type(struct) 而不是 Enum

Public Type colType
   ID As String
   SSN As String
   lName As String
   fName As String
End Type

And then create a object of type colType and set desired values to it.

然后创建一个 colType 类型的对象并为其设置所需的值。

Public myColType As colType

myColType.ID = "A"
myColType.SSN = "B"
myColType.lname = "H"
myColType.fName = "G"