Is there a way to get the enums in VBA?

2020-02-01 12:20发布

问题:

Is there a way to get the enums in VBA? Something like this example for C#, but for VBA?

using System;

class EnumsExampleZ
{
    private enum SiteNames
    {
        SomeSample = 1,
        SomeOtherSample = 2,
        SomeThirdSample = 3
    }

    static void Main()
    {
        Type enumType = typeof(SiteNames);
        string[] enumName = enumType.GetEnumNames();

        for (int i = 0; i < enumName.Length; i++)
        {
            Console.WriteLine(enumName[i]);
        }
    }
}

Lets say we have the following:

Enum FruitType
    Apple = 1
    Orange = 2
    Plum = 3
End Enum

How can we display on the immediate window these:

Apple
Orange
Plum

回答1:

Parsing the VBA code yourself with the VBIDE Extensibility library is going to appear nice & simple at first, and then you're going to hit edge cases and soon realize that you need to actually implement that part of the VBA spec in order to properly and successfully parse every possible way to define an enum in VBA.

I'd go with the simple solution.

That said Rubberduck is doing pretty much exactly that, and exposes an experimental COM API that allows you to enumerate all declarations (and their references) in the VBE, effectively empowering your VBA code with reflection-like capabilities; as of 2.0.11 (the latest release), the code would look something like this:

Public Enum TestEnum
    Foo
    Bar
End Enum

Public Sub ListEnums()
    With New Rubberduck.ParserState
        .Initialize Application.VBE
        .Parse
        Dim item As Variant
        For Each item In .UserDeclarations
            Dim decl As Rubberduck.Declaration
            Set decl = item
            If decl.DeclarationType = DeclarationType_EnumerationMember Then
                Debug.Print decl.ParentDeclaration.Name & "." & decl.Name
            End If
        Next
    End With
End Sub

And in theory would output this:

TestEnum.Foo
TestEnum.Bar

However we (ok, I did) broke something around the 2.0.9 release, so if you try that in 2.0.11 you'll get a runtime error complaining about an invalid cast:

That should be is an easy fix that we'll patch up by 2.0.12, but note that at that point the API is still experimental and very much subject to change (feature requests are welcome!), so I wouldn't recommend using it for anything other than toy projects.



回答2:

There is no built-in function, though it is easy enough to roll your own in a concrete case:

Enum FruitType
    Apple = 1
    Orange = 2
    Plum = 3
End Enum

Function EnumName(i As Long) As String
    EnumName = Array("Apple","Orange","Plum")(i-1)
End Function

If you have several different enums, you could add a parameter which is the string name of the enum and Select Case on it.

Having said all this, it might possible to do something with scripting the VBA editor, though it is unlikely to be worth it (IMHO).



回答3:

No - there is no native way to do this. You'd need to fully parse all of the user code and read the type libraries of any loaded projects and finally determine what scope each reference was referring to.

Enumerations can't be treated like reference types in VBA, and this due to the deep roots that VBA has in COM. Enums in VBA are more like aliases, and in fact, VBA doesn't even enforce type safety for them (again, because of COM interop - MIDL specs require that they are treated as a DWORD).

If you really need to do this in VBA, a good workaround would be to create your own enumeration class and use that instead.



回答4:

If the reason you're looking for enum names is because you mean to use them in a user interface, know that even in C# that's bad practice; in .net you could use a [DisplayAttribute] to specify a UI-friendly display string, but even then, that's not localization-friendly.

In excel-vba you can use Excel itself to remove data from your code, by entering it into a table, that can live in a hidden worksheet that can literally act as a resource file:

Then you can have a utility function that gets you the caption, given an enum value:

Public Enum SupportedLanguage
    Lang_EN = 2
    Lang_FR = 3
    Lang_DE = 4
End Enum


Public Function GetFruitTypeName(ByVal value As FruitType, Optional ByVal langId As SupportedLanguage = Lang_EN) As String
    Dim table As ListObject
    Set table = MyHiddenResourceSheet.ListObjects("FruitTypeNames")
    On Error Resume Next
    GetFruitTypeName = Application.WorksheetFunction.Vlookup(value, table.Range, langId, False)
    If Err.Number <> 0 Then GetFruitTypeName = "(unknown)"
    Err.Clear
    On Error GoTo 0
End Function

Or something like it. That way you keep code with code, and data with data. And you can quite easily extend it, too.



回答5:

Public Enum col: [____]: cPath: cFile: cType: End Enum 
Public Const colNames$ = "Path: cFile: cType"

Not directly an answer and might look pretty ugly, but I thought it might be useful to others.
In an old project I wanted to access columns with Enum (for example row(, col.cType) = 1).
I changed the column location, name, use, etc. pretty often, but with this lazy approach I could just rearrange the Enum and then copy paste the change in the string constant, and get the table headers:

Range("A1:C1").Value2 = Split(colNames, ": c")

Names starting with _ are hidden by default, so [____] is used for padding and to avoid "cPath = 1"



回答6:

For above "John Coleman"'s example I suggest to use next functions:

Function FruitType2Int(Fruit As FruitType)
    FruitType2Int = Format("0", Fruit)
    Debug.Print FruitType2Int
End Function

Function int2FruitString(i As Integer) As String
    If i = FruitType2Int(Orange) Then
        int2FruitString = "Orange"
    ElseIf i = FruitType2Int(Plum) Then
        int2FruitString = "Plum"
    ElseIf i = FruitType2Int(Apple) Then
        int2FruitString = "Apple"
    Else
        int2FruitString = "?"
    End If
    Debug.Print int2FruitString
End Function

Direct use of an Array indexes (without LBound() and etc.) may cause different resuts, depends on value in Option Base 1



回答7:

I think that the marvel CPearson's site has the answer with the [_First] and [_Last] trick. I have the need of speed up a lot of DB reading just to populate combo and list boxes with values in Office VBA application, and I just translate them to Enums. And of course, do a For Each like, with the For Next is a must, and the [_First] and [_Last] is the way to go. But, I have a lot of non-sequential Enums, each with 10 to 40 Enum itens, and code for each is too tediously. To unify all my combo and listbox feeding needs, I adapted CPearson's trick to non-sequential Enums too:

Sub EnumValueNamesWrapingAndUnwrapingToClipboard()
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        ' This creates a text string of the comma separated value names of an
        ' Enum data type. Put the cursor anywhere within an Enum definition
        ' and the code will create a comma separated string of all the
        ' enum value names. This can be used in a Select Case for validating
        ' values passed to a function. If the cursor is not within an enum
        ' definition when the code is executed, the results are unpredicable by CPearson
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim N As Long
        Dim txt As String, S As String
        Dim SL As Long, EL As Long, SC As Long, EC As Long
        Dim DataObj As MSForms.DataObject
        Dim auxTitle As String, auxStrValue As String, strAuxCase As String
        Dim counter As Integer, EnumMin As Integer, EnumMax As Integer
        Dim auxValue As Variant
        Dim EnumIsSequential As Boolean

        Const STR_ENUM As String = "enum "
            If VBE.ActiveCodePane Is Nothing Then
                Exit Sub
            End If
            With VBE.ActiveCodePane
                .GetSelection SL, SC, EL, EC
                With .CodeModule
                    S = .Lines(SL, 1)
                    Do Until InStr(1, S, STR_ENUM, vbTextCompare) > 0
                        N = N + 1
                        S = .Lines(SL - N, 1)
                    Loop
                    'Function title
                    auxTitle = Right$(S, Len(S) - InStr(1, S, STR_ENUM, vbTextCompare) - Len(STR_ENUM) + Len(" "))
                    N = SL - N + 1
                    S = .Lines(N, 1)
                    Do
                        S = .Lines(N, 1)
                        If InStr(1, S, "end enum", vbTextCompare) = 0 And InStr(1, S, "'", vbTextCompare) = 0 Then
                            txt = txt & " " & Trim(S) & ","
                        End If
                        N = N + 1
                    Loop Until InStr(1, S, "end enum", vbTextCompare) > 0
                    ReDim auxValue(0)
                    ReDim Preserve auxValue(0 To StringCountOccurrences(txt, "=") - 2) 'because of [_First] and [_Last]
                    For counter = 1 To UBound(auxValue)
                        auxStrValue = RetornaElementoDesignado(counter + 1, Left(txt, Len(txt) - 1))
                        If counter = 1 Then
                            EnumMin = CInt(Trim$(Right$(auxStrValue, Len(auxStrValue) - InStrRev(auxStrValue, "="))))
                            auxValue(counter) = Trim$(Left$(auxStrValue, InStr(1, auxStrValue, " = ")))
                        ElseIf counter = UBound(auxValue) Then
                            EnumMax = CInt(Trim$(Right$(auxStrValue, Len(auxStrValue) - InStrRev(auxStrValue, "="))))
                            auxValue(counter) = Trim$(Left$(auxStrValue, InStr(1, auxStrValue, " = ")))
                        Else
                            auxValue(counter) = Trim$(Left$(auxStrValue, InStr(1, auxStrValue, " = ")))
                        End If
                    Next counter
                End With
            End With
            EnumIsSequential = NumElements(auxValue) - 1 = EnumMax - EnumMin + 1
            strAuxCase = "Function ReturnNameEnum" & auxTitle & " (ByVal WhichEnum As " & auxTitle & ")As String" & vbCrLf _
                                 & "  Select Case WhichEnum" & vbCrLf
            For counter = 1 To UBound(auxValue)
                strAuxCase = strAuxCase & "     Case Is = " & auxTitle & "." & auxValue(counter) & vbCrLf _
                    & "          ReturnNameEnum" & auxTitle & " = " & ParseSpecialCharsAndDataTypeForSQL(auxValue(counter), False, True, False) & vbCrLf
            Next counter
            If EnumIsSequential Then
                strAuxCase = strAuxCase & "     Case Else" & vbCrLf _
                    & "          debug.print " & """Passed invalid """ & " & WhichEnum & " & """ WhichEnum As " & auxTitle & "! """ & vbCrLf _
                    & "    End Select" & vbCrLf _
                    & "End Function" & vbCrLf _
                    & "Function LoadEnum" & auxTitle & "InArray () As Variant" & vbCrLf _
                    & "    'If Enum is Sequential" & vbCrLf _
                    & "    Dim items() As Variant, item As Long, counter As Long" & vbCrLf _
                    & "    For item = " & auxTitle & ".[_first] To " & auxTitle & ".[_last]" & vbCrLf _
                    & "        counter = counter + 1" & vbCrLf _
                    & "    Next" & vbCrLf _
                    & "    ReDim items(counter * 2 - 1) '-1: it's 0-based..." & vbCrLf _
                    & "    For item = " & auxTitle & ".[_first] To " & auxTitle & ".[_last]" & vbCrLf _
                    & "        items(item * 2) = item" & vbCrLf _
                    & "    items(item * 2 + 1) = ReturnNameEnum" & auxTitle & "(item)" & vbCrLf _
                    & "        items(item * 2) = item" & vbCrLf _
                    & "    Next" & vbCrLf _
                    & "    LoadEnum" & auxTitle & "InArray=items()" & vbCrLf _
                    & "End Function"
            Else
                strAuxCase = strAuxCase & "     Case Else" & vbCrLf _
                  & "          debug.print " & """Passed invalid """ & " & WhichEnum & " & """ WhichEnum As " & auxTitle & "! """ & vbCrLf _
                  & "    End Select" & vbCrLf _
                  & "End Function" & vbCrLf _
                  & "Function LoadEnum" & auxTitle & "InArray () As Variant" & vbCrLf _
                  & "    'For Non-Sequential Enum" & vbCrLf _
                  & "    Dim items() As Variant, item As Long, ExistingEnum As Long" & vbCrLf _
                  & "    For item = " & auxTitle & ".[_first] To " & auxTitle & ".[_last]" & vbCrLf _
                  & "        if ReturnNameEnum" & auxTitle & "(item) <> """" then" & vbCrLf _
                  & "            ExistingEnum = ExistingEnum + 1" & vbCrLf _
                  & "            auxExistingEnum = auxExistingEnum & CStr(item) & "",""" & vbCrLf _
                  & "        end if" & vbCrLf _
                  & "    Next" & vbCrLf _
                  & "    auxExistingEnum = Left$(auxExistingEnum, Len(auxExistingEnum) - 1)" & vbCrLf _
                  & "    arrayExistingEnum = Split(auxExistingEnum, "","")" & vbCrLf _
                  & "    ReDim items(ExistingEnum * 2 - 1) '-1: it's 0-based..." & vbCrLf _
                  & "    If ReturnNameEnum" & auxTitle & "(arrayExistingEnum(item)) = """" Then GoTo continue" & vbCrLf _
                  & "        items(item * 2) = arrayExistingEnum(item)" & vbCrLf _
                  & "        items(item * 2 + 1) = ReturnNameEnum" & auxTitle & "(arrayExistingEnum(item))" & vbCrLf _
                  & "continue:" & vbCrLf _
                  & "    Next" & vbCrLf _
                  & "    LoadEnum" & auxTitle & "InArray=items()" & vbCrLf _
                  & "End Function"
            End If
            Set DataObj = New MSForms.DataObject
            With DataObj
                .SetText strAuxCase
                .PutInClipboard
                Debug.Print strAuxCase
            End With
            Set DataObj = Nothing
        End Sub

I added skip comment lines - I do a lot while developing.

I did not treat Enum that is not in Ascendant order; could be done, but I'm too OCD to allow an unordered Enum ;) and ordinarily, my Enums are coming from DB with an ORDER BY on the proper value (see at end of this answer).

Of course, it depends on [_First] and [_Last] values added properly.

And, answering your question, you can do a:

?ReturnNameEnumWhateverNamedItIs(FruitType.Apple)
Apple

As a bonus, and for me the main reason to adapt the CPearson's procedure, it loads in a unidimensional array tuples of value/name of Enum; so, we can navigate all Enum values with:

auxArray=LoadEnumWhateverNameYouGaveItInArray()
For counter = lbound(auxArray) to ubound(auxArray) step 2
     EnumValue = auxArray(counter)
     EnumStringName = auxArray(counter+1)
Next counter

The procedure is generating one of two different functions LoadEnumWhateverNameYouGaveItInArray() versions based if Enum is sequential or not.

You can forget about the sequential; the non-sequential enum function grab both situations; I left here because I first developed it and after adapted to the non-sequential case, and we never know when we'll need less code lines ;)

Notice that although Enum is natively Long, I used Integer in counter/EnumMin/EnumMax, just because the Enums that we need to know its names are less than hundred, like fruit names.

Hope it helps someone.

Edit: To complete the explanation, this is the procedure that I use to extract Enum from tables and write them in a static module:

Sub CreateEnumBasedOnTableValues(ByVal EnumName As String, ByVal CnnStr As String _
   , ByVal DataS As String, ByVal strSQL As String _
   , ByVal EnumValueField As String, ByVal EnumNameField As String _
   , ByVal TreatIllegalNames As Boolean, ByVal EliminateWhiteSpaces As Boolean _
   , Optional ByVal ToEscapeWhiteSpace As String = "")
            Dim DataObj As MSForms.DataObject
            Dim cnn As ADODB.Connection
            Dim rst As ADODB.Recordset
            Dim auxEnum As String, bBracket As String, eBracket As String, auxRegex As String
            Dim LastValue As Long

            Set cnn = New ADODB.Connection
            Set rst = New ADODB.Recordset
            cnn.Open CnnStr & vbCrLf & DataS
            rst.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
            If TreatIllegalNames Then bBracket = "[": eBracket = "]"
            auxEnum = "Public Enum " & EnumName & vbCrLf
            auxEnum = auxEnum & "    [_First] = "
            With rst
                .MoveFirst
                auxEnum = auxEnum & CStr(.Fields(EnumValueField)) & vbCrLf
                Do While Not .EOF
                    auxEnum = auxEnum & "    " & bBracket _
                            & IIf(EliminateWhiteSpaces, Replace(.Fields(EnumNameField), " ", ToEscapeWhiteSpace), .Fields(EnumNameField)) _
                            & eBracket & " = " & CStr(.Fields(EnumValueField)) & vbCrLf
                    LastValue = .Fields(EnumValueField)
                    .MoveNext
                Loop
                .Close
            End With
            auxEnum = auxEnum & "    [_Last] = " & CStr(LastValue) & vbCrLf
            auxEnum = auxEnum & "End Enum " & vbCrLf

            Set rst = Nothing
            cnn.Close
            Set cnn = Nothing
            Set DataObj = New MSForms.DataObject
            With DataObj
                .SetText auxEnum
                .PutInClipboard
                Debug.Print auxEnum
            End With
            Set DataObj = Nothing
     End Sub

Just remember to pass the strSQL like that:

"SELECT EnumNameField, EnumValueField " & _
"FROM tblTarget WHERE EnumValueField Is NOT NULL " & _
"ORDER BY EnumValueField"

Usually, I use the EliminateWhiteSpaces boolean with ToEscapeWhiteSpace = "_", but is a personal preference.



回答8:

Any method which does not return a keyed collection or (preferably a scripting dictionary) will be prone to errors if the enumeration range is not a contiguous range, such as the case where you are using the enumeration to map to bits. My solution to this has been to develop a class of 'EnumerationDictionary' which allows arrays of the enumeration or the enumeration names to be returned, and name to be looked up given an enumeration and a string to be used to retrieve an enumeration. The example below is for colours in a word document and shows how to combine an internal enumeration with additional user defined values. Its a bit clunky but works very well.

Option Explicit

' A new enumeration for colour has been created to allow
' the inclusion of custom colours
' The wdColor enumeration values are the RGB vlaue as a decimal signed long
' For the hexadecimal representation the colours are BGR not RGB
' e.g. 0xXXBBGGRR not Ox00RRGGBB

Public Enum UserColour
    Aqua = wdColorAqua                                                     '13421619    0x00CCCC33
    Automatic = wdColorAutomatic                                           '-16777216   0xFF000000
    Black = wdColorBlack                                                   '0           0x00000000
    Blue = wdColorBlue                                                     '16711680    0x00FF0000
    BlueGray = wdColorBlueGray                                             '10053222
    BrightGreen = wdColorBrightGreen                                       '65280       0x0000FF00
    Brown = wdColorBrown                                                   '13209
    DarkBlue = wdColorDarkBlue                                             '8388608
    DarkGreen = wdColorDarkGreen                                           '13056
    DarkRed = wdColorDarkRed                                               '128         0x00000080
    DarkTeal = wdColorDarkTeal                                             '6697728
    DarkYellow = wdColorDarkYellow                                         '32896
    Gold = wdColorGold                                                     '52479
    Gray05 = wdColorGray05                                                 '15987699
    Gray10 = wdColorGray10                                                 '15132390
    Gray125 = wdColorGray125                                               '14737632
    Gray15 = wdColorGray15                                                 '14277081
    Gray20 = wdColorGray20                                                 '13421772
    Gray25 = wdColorGray25                                                 '12632256
    Gray30 = wdColorGray30                                                 '11776947
    Gray35 = wdColorGray35                                                 '10921638
    Gray375 = wdColorGray375                                               '10526880
    Gray40 = wdColorGray40                                                 '10066329
    Gray45 = wdColorGray45                                                 '9211020
    Gray50 = wdColorGray50                                                 '8421504
    Gray55 = wdColorGray55                                                 '7566195
    Gray60 = wdColorGray60                                                 '6710886
    Gray625 = wdColorGray625                                               '6316128
    Gray65 = wdColorGray65                                                 '5855577
    Gray70 = wdColorGray70                                                 '5000268
    Gray75 = wdColorGray75                                                 '4210752
    Gray80 = wdColorGray80                                                 '3355443
    Gray85 = wdColorGray85                                                 '2500134
    Gray875 = wdColorGray875                                               '2105376
    Gray90 = wdColorGray90                                                 '1644825
    Gray95 = wdColorGray95                                                 '789516
    Green = wdColorGreen                                                   '32768
    Indigo = wdColorIndigo                                                 '10040115
    Lavender = wdColorLavender                                             '16751052
    LightBlue = wdColorLightBlue                                           '16737843
    LightGreen = wdColorLightGreen                                         '13434828
    LightOrange = wdColorLightOrange                                       '39423
    LightTurquoise = wdColorLightTurquoise                                 '16777164
    LightYellow = wdColorLightYellow                                       '10092543
    Lime = wdColorLime                                                     '52377
    OliveGreen = wdColorOliveGreen                                         '13107
    Orange = wdColorOrange                                                 '26367
    PaleBlue = wdColorPaleBlue                                             '16764057
    Pink = wdColorPink                                                     '16711935
    Plum = wdColorPlum                                                     '6697881
    Red = wdColorRed                                                       '255         0x000000FF
    Rose = wdColorRose                                                     '13408767
    SeaGree = wdColorSeaGreen                                              '6723891
    SkyBlue = wdColorSkyBlue                                               '16763904
    Tan = wdColorTan                                                       '10079487
    Teal = wdColorTeal                                                     '8421376
    Turquoise = wdColorTurquoise                                           '16776960
    Violet = wdColorViolet                                                 '8388736
    White = wdColorWhite                                                   '16777215    0x00FFFFFF
    Yellow = wdColorYellow                                                 '65535
    ' Add custom s from this point onwards
    HeadingBlue = &H993300                                                 'RGB(0,51,153)   0x00993300
    HeadingGreen = &H92D050                                                'RGB(146,208,80) 0x0050D092

End Enum


Private Type Properties

    enum_gets_string                           As Scripting.Dictionary
    string_gets_enum                           As Scripting.Dictionary

End Type

Private p                                       As Properties

Private Sub Class_Initialize()

    Set p.enum_gets_string = New Scripting.Dictionary
    Set p.string_gets_enum = New Scripting.Dictionary

    With p.enum_gets_string

        .Add Key:=Aqua, Item:="Aqua"
        .Add Key:=Automatic, Item:="Automatic"
        .Add Key:=Black, Item:="Black"
        .Add Key:=Blue, Item:="Blue"
        .Add Key:=BlueGray, Item:="BlueGray"
        .Add Key:=BrightGreen, Item:="BrightGreen"
        .Add Key:=Brown, Item:="Brown"
        .Add Key:=DarkBlue, Item:="DarkBlue"
        .Add Key:=DarkGreen, Item:="DarkGreen"
        .Add Key:=DarkRed, Item:="DarkRed"
        .Add Key:=DarkTeal, Item:="DarkTeal"
        .Add Key:=DarkYellow, Item:="DarkYellow"
        .Add Key:=Gold, Item:="Gold"
        .Add Key:=Gray05, Item:="Gray05"
        .Add Key:=Gray10, Item:="Gray10"
        .Add Key:=Gray125, Item:="Gray125"
        .Add Key:=Gray15, Item:="Gray15"
        .Add Key:=Gray20, Item:="Gray20"
        .Add Key:=Gray25, Item:="Gray25"
        .Add Key:=Gray30, Item:="Gray30"
        .Add Key:=Gray35, Item:="Gray35"
        .Add Key:=Gray375, Item:="Gray375"
        .Add Key:=Gray40, Item:="Gray40"
        .Add Key:=Gray45, Item:="Gray45"
        .Add Key:=Gray50, Item:="Gray50"
        .Add Key:=Gray55, Item:="Gray55"
        .Add Key:=Gray60, Item:="Gray60"
        .Add Key:=Gray625, Item:="Gray625"
        .Add Key:=Gray65, Item:="Gray65"
        .Add Key:=Gray70, Item:="Gray70"
        .Add Key:=Gray75, Item:="Gray75"
        .Add Key:=Gray80, Item:="Gray80"
        .Add Key:=Gray85, Item:="Gray85"
        .Add Key:=Gray875, Item:="Gray875"
        .Add Key:=Gray90, Item:="Gray90"
        .Add Key:=Gray95, Item:="Gray95"
        .Add Key:=Green, Item:="Green"
        .Add Key:=Indigo, Item:="Indigo"
        .Add Key:=Lavender, Item:="Lavender"
        .Add Key:=LightBlue, Item:="LightBlue"
        .Add Key:=LightGreen, Item:="LightGreen"
        .Add Key:=LightOrange, Item:="LightOrange"
        .Add Key:=LightTurquoise, Item:="LightTurquoise"
        .Add Key:=LightYellow, Item:="LightYellow"
        .Add Key:=Lime, Item:="Lime"
        .Add Key:=OliveGreen, Item:="OliveGreen"
        .Add Key:=Orange, Item:="Orange"
        .Add Key:=PaleBlue, Item:="PaleBlue"
        .Add Key:=Pink, Item:="Pink"
        .Add Key:=Plum, Item:="Plum"
        .Add Key:=Red, Item:="Red"
        .Add Key:=Rose, Item:="Rose"
        .Add Key:=SeaGree, Item:="SeaGreen"
        .Add Key:=SkyBlue, Item:="SkyBlue"
        .Add Key:=Tan, Item:="Tan"
        .Add Key:=Teal, Item:="Teal"
        .Add Key:=Turquoise, Item:="Turquoise"
        .Add Key:=Violet, Item:="Violet"
        .Add Key:=White, Item:="White"
        .Add Key:=Yellow, Item:="Yellow"
        .Add Key:=HeadingBlue, Item:="HeadingBlue"
        .Add Key:=HeadingGreen, Item:="HeadingGreen"

    End With

    ' Now compile the reverse lookup
    Set p.string_gets_enum = ReverseDictionary(p.enum_gets_string, "Reversing userCOLOUR.enum_gets_string")

End Sub

Public Property Get Items() As Variant
    proj.Log.Trace s.locale, "{0}.Items", TypeName(Me)

    Set Items = p.enum_gets_string.Items

End Property


Public Property Get Enums() As Variant
' Returns an array of Enums")

    Set Enums = p.enum_gets_string.Keys

End Property


Public Property Get Item(ByVal this_enum As UserColour) As String
' Returns the Item for a given Enum")

    Item = p.enum_gets_string.Item(this_enum)

End Property


' VBA will not allow a property/function Item of 'Enum' so we use
' ü (alt+0252) to sidestep the keyword clash for this property Item
Public Property Get Enüm(ByVal this_item As String) As UserColour

    Enüm = p.string_gets_enum.Item(this_item)

End Property


Public Function HoldsEnum(ByVal this_enum As UserColour) As Boolean

    HoldsEnum = p.enum_gets_string.Exists(this_enum)

End Function


Public Function LacksEnum(ByVal this_enum As UserColour) As Boolean

    LacksEnum = Not Me.HoldsEnum(this_enum)

End Function


Public Function HoldsItem(ByVal this_item As String) As Boolean

    HoldsItem = p.string_gets_enum.Exists(this_item)

End Function


Public Function LacksItem(ByVal this_item As String) As Boolean

    LacksItem = Not Me.HoldsItem(this_item)

End Function


Public Function Count() As Long

    Count = p.enum_gets_string.Count

End Function

Plus the following utility to reverse dictionaries.

Public Function ReverseDictionary(ByRef this_dict As Scripting.Dictionary) As Scripting.Dictionary
' Swaps keys for items in scripting.dictionaries.
' Keys and items must be unique which is usually the case for an enumeration

    Dim my_key                                  As Variant
    Dim my_keys                                 As Variant
    Dim my_reversed_map                         As Scripting.Dictionary
    Dim my_message                              As String

    On Error GoTo key_is_not_unique
    Set my_reversed_map = New Scripting.Dictionary
    my_keys = this_dict.Keys

    For Each my_key In my_keys

        my_reversed_map.Add Key:=this_dict.Item(my_key), Item:=my_key

    Next

    Set ReverseDictionary = my_reversed_map
    Exit Function

key_is_not_unique:

    On Error GoTo 0

    MsgBox _
        Title:="Reverse Dictionary Error", _
        Prompt:="The key and item are not unique Key:=" & my_key & " Item:= " & this_dict.Item(my_key), _
        Buttons:=vbOKOnly

    Set ReverseDictionary = Nothing

End Function