有没有办法在 VBA 中获取枚举？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/41578348/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Is there a way to get the enums in VBA?
提问by Vityata
Is there a way to get the enums in VBA? Something like this example for C#, but for VBA?
有没有办法在 VBA 中获取枚举？类似于 C# 的这个示例，但适用于 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
回答by John Coleman
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 Caseon it.
如果您有多个不同的枚举，则可以添加一个参数，该参数是枚举的字符串名称及其Select Case上。
Having said all this, it might possible to do something with scripting the VBA editor, though it is unlikely to be worth it (IMHO).
说了这么多，可能可以通过编写 VBA 编辑器的脚本来做一些事情，尽管这不太值得（恕我直言）。
回答by Comintern
No - there is no native way to do this. You'd need to fully parse all of the user code andread the type libraries of any loaded projects and finallydetermine 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).
枚举不能像 VBA 中的引用类型一样对待，这是由于 VBA 在 COM 中的根深蒂固。VBA 中的枚举更像是别名，事实上，VBA 甚至没有为它们强制类型安全（同样，因为 COM 互操作 - MIDL 规范要求将它们视为 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.
如果您确实需要在 VBA 中执行此操作，一个好的解决方法是创建您自己的枚举类并改用它。
回答by Mathieu Guindon
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.
自己用 VBIDE 扩展性库解析 VBA 代码一开始会看起来很好很简单，然后你会遇到边缘情况，很快就会意识到你需要实际实现 VBA 规范的那部分，以便正确和成功解析在 VBA 中定义枚举的所有可能方式。
I'd go with the simple solution.
我会选择简单的解决方案。
That said Rubberduckis doing pretty much exactly that, and exposes an experimentalCOM API that allows you to enumerate alldeclarations (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:
这就是说，Rubberduck所做的几乎就是这样，并公开了一个实验性的COM API，它允许您枚举VBE 中的所有声明（及其引用），从而有效地为您的 VBA 代码赋予类似反射的功能；从 2.0.11（最新版本）开始，代码如下所示：
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 theorywould 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:
然而，我们（好吧，我做了）在 2.0.9 版本周围破坏了一些东西，所以如果你在 2.0.11 中尝试，你会得到一个运行时错误，抱怨无效的强制转换：
That should beisan 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.0.12 之前修补，但请注意，此时 API 仍处于实验阶段，并且很可能会发生变化（欢迎功能请求！），所以我不建议使用它适用于玩具项目以外的任何事情。
回答by Mathieu Guindon
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.
如果您正在寻找枚举名称的原因是因为您打算在用户界面中使用它们，请知道即使在 C# 中这也是不好的做法；在 .net 中，您可以使用 a[DisplayAttribute]来指定 UI 友好的显示字符串，但即便如此，这也不是本地化友好的。
In excel-vbayou can use Excel itself to remove datafrom your code, by entering it into a table, that can live in a hidden worksheet that can literally act as a resource file:
在excel-vba 中，您可以使用 Excel 本身从代码中删除数据，方法是将其输入到表格中，该表格可以存在于隐藏的工作表中，该工作表实际上可以充当资源文件：
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.
或者类似的东西。这样你就可以用代码保存代码，用数据保存数据。你也可以很容易地扩展它。
回答by Leon Rom
For above "John Coleman"'s example I suggest to use next functions:
对于上面“John Coleman”的例子，我建议使用下一个函数：
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 Arrayindexes (without LBound()and etc.) may cause different resuts, depends on value in Option Base 1
直接使用Array索引（没有LBound()等）可能会导致不同的结果，取决于Option Base 1
回答by Marcelo Scofano
I think that the marvel CPearson'ssite 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:
我认为奇迹CPearson 的网站通过 [_First] 和 [_Last] 技巧给出了答案。我需要加快大量的数据库读取速度，以便在 Office VBA 应用程序中使用值填充组合框和列表框，而我只是将它们转换为枚举。当然，做 For Each 之类的，For Next 是必须的，而 [_First] 和 [_Last] 是要走的路。但是，我有很多非顺序的 Enum，每个 Enum 有 10 到 40 个 Enum，每个的代码太乏味了。为了统一我所有的组合和列表框馈送需求，我也将 CPearson 的技巧应用于非序列枚举：
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).
我没有处理非升序的 Enum；可以做到，但我太强迫症了，不允许使用无序的 Enum ;) 并且通常，我的 Enum 来自 DB 并带有正确值的 ORDER BY（参见本答案末尾）。
Of course, it depends on [_First] and [_Last] values added properly.
当然，这取决于正确添加的 [_First] 和 [_Last] 值。
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:
作为奖励，对我来说，适应 CPearson 程序的主要原因是，它加载了枚举值/名称的一维数组元组；因此，我们可以使用以下命令导航所有 Enum 值：
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.
该过程根据 Enum 是否连续生成两个不同的函数 LoadEnumWhateverNameYouGaveItInArray() 版本之一。
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.
请注意，虽然 Enum 本身就是 Long，但我在 counter/EnumMin/EnumMax 中使用了 Integer，只是因为我们需要知道其名称的 Enum 少于一百，例如水果名称。
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:
编辑：为了完成解释，这是我用来从表中提取 Enum 并将它们写入静态模块的过程：
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:
请记住像这样传递 strSQL ：
"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.
通常，我将 EliminateWhiteSpaces 布尔值与 ToEscapeWhiteSpace = "_" 一起使用，但这是个人偏好。
回答by Slai
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:
不是直接的答案，可能看起来很丑陋，但我认为它可能对其他人有用。
在一个旧项目中，我想使用 Enum 访问列（例如row(, col.cType) = 1）。
我经常更改列的位置、名称、用途等，但是使用这种懒惰的方法，我可以重新排列 Enum，然后将更改复制粘贴到字符串常量中，并获取表标题：
Range("A1:C1").Value2 = Split(colNames, ": c")
Names starting with _ are hiddenby default, so [____]is used for padding and to avoid "cPath = 1"
默认情况下隐藏以 _ 开头的名称，因此[____]用于填充并避免“ cPath = 1”
回答by freeflow
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.
如果枚举范围不是连续范围，则任何不返回键控集合或（最好是脚本字典）的方法都容易出错，例如您使用枚举映射到位的情况。我对此的解决方案是开发一个“EnumerationDictionary”类，它允许返回枚举数组或枚举名称，并在给定枚举和用于检索枚举的字符串的情况下查找名称。下面的示例适用于 Word 文档中的颜色，并展示了如何将内部枚举与其他用户定义的值组合在一起。它有点笨重，但效果很好。
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
