有没有办法在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]);
}
}
}
假设我们有以下内容：
Enum FruitType
Apple = 1
Orange = 2
Plum = 3
End Enum
我们如何在即时窗口显示这些：
Apple
Orange
Plum
8 个答案:
答案 0 :(得分：7)
没有内置功能，虽然很容易在具体情况下推出自己的功能：
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
如果您有多个不同的枚举，可以添加一个参数，该参数是枚举的字符串名称，并在其上添加Select Case。
说完这一切之后，可以用VBA编辑器编写脚本来做一些事情，虽然它不太值得（IMHO）。
答案 1 :(得分：4)
不 - 没有本地方法可以做到这一点。您需要完全解析所有用户代码和读取任何已加载项目的类型库和最终 确定每个引用的范围是什么提到。
枚举不能像VBA中的引用类型那样对待，这是由于VBA在COM中具有深层根源。 VBA中的枚举更像是别名，事实上，VBA甚至不为它们强制执行类型安全（再次，因为COM互操作 - MIDL规范要求将它们视为DWORD）。
如果您真的需要在VBA中执行此操作，一个好的解决方法是创建自己的枚举类并使用它。
答案 2 :(得分：4)
使用VBIDE可扩展性库自行解析VBA代码看起来很不错一开始很简单，然后你会遇到边缘情况并很快意识到你需要实际实现VBA规范的那一部分，以便正确并成功地解析每种可能的方式来定义VBA中的枚举。
我会选择the simple solution。
那就是说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
理论上会输出：
TestEnum.Foo
TestEnum.Bar
但是我们（好吧，我做了）破坏了2.0.9版本的内容，所以如果你在2.0.11中尝试，你会得到一个运行时错误抱怨无效的演员：< / p>
{/}请求是受欢迎的！），所以我不建议将它用于除玩具项目以外的任何东西。
答案 3 :(得分：2)
如果您要查找枚举名称的原因是因为您打算在用户界面中使用它们，请知道即使在C＃中这是不好的做法;在.net中，你可以使用[DisplayAttribute]指定一个界面友好的显示字符串，但即使这样，这也不是本地化的。
在excel-vba中，您可以使用Excel本身从代码中删除数据，方法是将其输入到表中，该表可以存在于隐藏的工作表中可以直接作为资源文件：
然后，您可以使用实用程序函数，在给定枚举值的情况下为您提供标题：
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
或类似的东西。这样，您就可以使用代码保存代码，使用数据保存数据。你也可以很容易地扩展它。
答案 4 :(得分：1)
Public Enum col: [____]: cPath: cFile: cType: End Enum
Public Const colNames$ = "Path: cFile: cType"
不是直接答案，可能看起来很难看，但我认为这可能对其他人有用
在一个旧项目中，我想使用Enum访问列（例如row(, col.cType) = 1）
我经常更改列位置，名称，使用等，但是使用这种惰性方法我可以重新排列Enum，然后将更改粘贴到字符串常量中，并获取表头：
Range("A1:C1").Value2 = Split(colNames, ": c")
默认情况下，以_开头的名称为hidden，因此[____]用于填充并避免＆＃34; cPath = 1＆＃34;
答案 5 :(得分：1)
对于上面的“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
直接使用Array索引（不使用 LBound（）等）可能导致不同的结果，取决于Option Base 1
答案 6 :(得分：1)
我认为神奇的CPearson's网站提供了[_First]和[_Last]技巧的答案。 我需要加快很多数据库的读取速度，只是为了用Office VBA应用程序中的值填充组合框和列表框，我只是将它们转换为Enums。 当然，要做一个For Each like，For Next是必须的，并且[_First]和[_Last]是必经之路。 但是，我有很多非顺序的Enum，每个Enum具有10到40个Enum iten，并且每个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
我添加了跳过注释行-开发过程中我做了很多事情。
我没有对待不按升序排列的枚举；可以完成，但是我太强迫症了，不允许无序的Enum;），通常，我的Enum是来自DB的，并且ORDER BY的值正确（参见此答案的结尾）。
当然，这取决于正确添加的[_First]和[_Last]值。
然后，回答您的问题，您可以执行以下操作：
?ReturnNameEnumWhateverNamedItIs(FruitType.Apple)
Apple
作为奖励，对我来说，适应CPearson程序的主要原因是，它将装入值/名称为Enum的一维数组元组；因此，我们可以使用以下命令导航所有Enum值：
auxArray=LoadEnumWhateverNameYouGaveItInArray()
For counter = lbound(auxArray) to ubound(auxArray) step 2
EnumValue = auxArray(counter)
EnumStringName = auxArray(counter+1)
Next counter
该过程根据Enum是否为顺序生成两个不同的函数之一LoadEnumWhateverNameYouGaveItInArray（）。
您可以忘记顺序；非顺序枚举函数可以同时处理两种情况；我之所以离开这里，是因为我首先开发了它，然后适应了非顺序情况，但我们不知道何时需要更少的代码行;）
请注意，尽管Enum本身是Long，但我在counter / EnumMin / EnumMax中使用了Integer，只是因为我们需要知道其名称的Enum少于100，例如水果名称。
希望它可以帮助某人。
编辑： 为了完成说明，以下是我从表中提取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
只需记住像这样传递strSQL：
"SELECT EnumNameField, EnumValueField " & _
"FROM tblTarget WHERE EnumValueField Is NOT NULL " & _
"ORDER BY EnumValueField"
通常，我将EliminateWhiteSpaces布尔值与ToEscapeWhiteSpace =“ _”结合使用，但这是个人喜好。
答案 7 :(得分：0)
如果枚举范围不是连续范围，例如不使用枚举映射到位的情况，则任何不返回键集合或（最好是脚本字典）的方法都容易出错。我对此的解决方案是开发一个'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
加上以下实用程序可以逆转字典。
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
相关问题
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？