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)