Excel VBA - установка значений перечислимых элементов
В модуле класса есть
Private Enum colType
ID = "A"
SSN = "B"
lName = "H"
fName = "G"
End Enum
как частный член. Всякий раз, когда инициализирует класс, я получаю сообщение Ошибка компиляции: тип несоответствия. Если я объявляю colType как Private Enum coltype As String. Это становится красным как ошибка, и я получаю сообщение Ошибка компиляции: ожидаемый конец сообщения.
Указывает значения перечисляемых элементов Не разрешено в excel VBA?
Ответы
Ответ 1
Как написано в комментариях, это невозможно. Существует возможное обходное решение, хотя я использовал его в прошлом. Есть:
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 в свойство.
Ответ 2
Мне очень нравится решение ex-man в определенных обстоятельствах, по этой причине я его поддержал. Решение, которое чаще всего ставится, идет по следующим строкам:
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"
Ответ 3
Я очень долго искал ответ на этот вопрос. Я не хочу, чтобы нужно было обновить содержимое Enum в случае оператора Case или массива. Я не мог найти ответ, но мне удалось это сделать после того, как я нашел код для изменения содержимого модуля. Изменение этого файла привело к следующему рабочему коду, который будет помещен в 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
Ответ 4
Чтобы улучшить решение 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
Ответ 5
Длинными целыми числами в 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
Ответ 6
Я надеюсь, что эта помощь
Ссылка: (требуется Microsoft Visual Basic для расширяемости приложения 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
Ответ 7
Обновлено и исправлено
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
Ответ 8
Вместо 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"
Ответ 9
Мое решение этого выглядит так:
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)
