在课堂模块中有
Private Enum colType
ID = "A"
SSN = "B"
lName = "H"
fName = "G"
End Enum
作为私人会员。每当类初始化时，我都会收到编译错误：类型不匹配消息。如果我将colType声明为Private Enum coltype As String。这会突出显示为红色错误，我收到编译错误：预期的结束语消息。
在excel VBA中指定枚举元素的值是不允许的吗？
答案 0 :(得分：12)
如评论中所述，这是不可能的。虽然我过去使用过，但仍有可能的解决方法。有：
Private Enum colType
ID = 1
SSN = 2
lName = 3
fName = 4
End Enum
然后创建一个单独的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
这不是最通用的解决方案，但它很容易实现并且它可以完成工作......如果你已经在类模块中使用了这个，你甚至可以在私有colType变量上使用属性而且不需要colType输入到属性中。
答案 1 :(得分：9)
在某些情况下，我非常喜欢前人的解决方案，因此我对它进行了投票。更经常被假定的解决方案如下：
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"
答案 2 :(得分：2)
我一直在寻找这个问题答案的很长时间。我不想在Case语句或数组中重新放置Enum的内容。我找不到答案，但是在找到代码改变模块内容之后，我已经设法做了。对其的更改产生了以下工作代码，放在Module1中：
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
答案 3 :(得分：1)
为了改进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
答案 4 :(得分：0)
Enum中的长整数可以是Base-10编码。下面的ToAlpha函数将数字转换为Base-26，用大写字母字符表示。要获取该数字，请使用字符串调用ToLong函数。
这最多可以处理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
答案 5 :(得分：0)
我希望这个帮助
参考:( 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
要激活所需参考副本以下代码，然后将其删除
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
答案 6 :(得分：0)
更新并加冕
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
答案 7 :(得分：0)
定义一个Type（struct）而不是Enum
Public Type colType
ID As String
SSN As String
lName As String
fName As String
End Type
然后创建一个colType类型的对象并为其设置所需的值。
Public myColType As colType
myColType.ID = "A"
myColType.SSN = "B"
myColType.lname = "H"
myColType.fName = "G"
答案 8 :(得分：0)
我对此的解决方案如下：
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
使用Choose看起来更整洁。
示例用法：... = GetEnumName(ColType.ID)