我有一个用户表单，允许我输入搜索词，然后（从ComboBox中）从下拉列表中选择一种“颜色”。下拉值以wdRed，wdBlue，wdYellow等存储在列表中。目标是在单击名为“ Highlight_Widget”的命令按钮后，以选择的颜色突出显示搜索词的每个实例。
命令按钮内的代码为：
Private Sub cmd_Run_Click()
Dim sFind As String
Dim sColor As String
Selection.HomeKey wdStory
sFind = Input_Search_Term.Value
sColor = Input_Color.Value
Debug.Print GetColorValue(sColor) ' for testing, and it prints the numeric color number
Do Until Selection.Find.Found = False
Selection.Range.HighlightColorIndex = GetColorValue(sColor)
Selection.MoveRight
Selection.Find.Execute
Loop
End Sub
Function GetColorValue(color As String) As Long
Dim lngWdColor As Long
Select Case color
Case "wdRed"
lngWdColor = 255
Case "wdBrightGreen"
lngWdColor = 65280
Case "wdTurquoise"
lngWdColor = 16776960
End Select
GetColorValue = lngWdColor
End Function
Private Sub UserForm_Initialize()
With Input_Color
.AddItem "wdRed"
.AddItem "wdBrightGreen"
.AddItem "wdTurquoise"
End With
End Sub
答案 0 :(得分：1)
wd颜色名称是一个枚举，它们是long值的“人性化”名称。但是它们表示long值，并且不是字符串。下拉Value返回一个字符串，这就是为什么类型不匹配的原因。
您可以使用Select Case从long返回string。也许作为一个单独的功能。例如（您需要扩展此示例以使用列出的颜色）：
Function GetColorValue(color as String) As Long
Dim lngWdColor as long
Select Case color
Case "wdRed"
lngWdColor = 6
Case "wdGreen"
lngWdColor = 11
End Select
GetColorValue = lngWdColor
End Function
在问题代码中：
Selection.Range.HighlightColorIndex = GetColorValue(sColor)
答案 1 :(得分：0)
您面临的问题是VBA中的常见问题，因为该语言不支持反射。例如，这意味着对于枚举我们不能说。
wdTurquoise.ToString
并获得字符串“ wdTurquoise”的返回值。
通过创建一个封装您正在使用的枚举的新类，可以很好地解决此问题。我经常使用这类类，并将它们称为反向查找枚举字典。我已经创建了用于管理wdColorIndex的类，代码如下。
代码要求您转到Tools.References并选中“ Microsoft Scripting Runtime”框，因为该类依赖于“ scripting.dictionary”（内置在“ Collection”中的VBA的高级版本）。
添加一个新的类模块，并将其命名为“ wdColorIndexGetsName”
将下面的代码放在类中。有很多代码，因为它基于我拥有的模板，并引入了很多其他功能，除了值到名称转换。
Option Explicit
' This module requires Microsoft Scripting runtime
' See Tools.References and ensure that the box for
' 'Microsoft Scripting Runtime' is ticked
Private Type properties
value_gets_variant As Scripting.Dictionary
variant_gets_value As Scripting.Dictionary
End Type
Private p As properties
Private Sub Class_Initialize()
Set p.value_gets_variant = New Scripting.Dictionary
Set p.variant_gets_value = New Scripting.Dictionary
With p.value_gets_variant
.Add Key:=wdAuto, Item:="Automatic" ' 0
.Add Key:=wdBlack, Item:="Black" ' 1
.Add Key:=wdBlue, Item:="Blue" ' 2
.Add Key:=wdBrightGreen, Item:="Bright green" ' 4
.Add Key:=wdByAuthor, Item:="User defined" ' -1
.Add Key:=wdDarkBlue, Item:="Dark blue" ' 9
.Add Key:=wdDarkRed, Item:="Dark red" ' 13
.Add Key:=wdDarkYellow, Item:="Dark yellow" ' 14
.Add Key:=wdGray25, Item:="Gray 25" ' 16
.Add Key:=wdGray50, Item:="Gray 50" ' 15
.Add Key:=wdGreen, Item:="Green" ' 11
' Can't use wdNoHighlight as it has the same value as
' wdAutomatic
'.Add Key:=wdNoHighlight, Item:="Remove highlight" ' 0
.Add Key:=wdPink, Item:="Pink" ' 5
.Add Key:=wdRed, Item:="Red" ' 6
.Add Key:=wdTeal, Item:="Teal" ' 10
.Add Key:=wdTurquoise, Item:="Turquoise" ' 3
.Add Key:=wdViolet, Item:="Violet" ' 12
.Add Key:=wdWhite, Item:="White" ' 8
.Add Key:=wdYellow, Item:="Yellow" ' 7
End With
' Now compile the reverse lookup
Set p.variant_gets_value = ReverseDictionary(p.value_gets_variant, "wdColorIndexGetsName.variant_gets_value")
End Sub
Public Property Get Names() As Variant
Set Names = p.value_gets_variant.Keys
End Property
Public Property Get Values() As Variant
Set Values = p.value_gets_variant.Keys
End Property
Public Property Get Name(ByVal this_Value As WdColorIndex) As Variant
Name = p.value_gets_variant.Item(this_Value)
End Property
Public Property Get Value(ByVal this_name As Variant) As WdColorIndex
Value = p.variant_gets_value.Item(this_name)
End Property
Public Function HoldsValue(ByVal this_Value As WdColorIndex) As Boolean
HoldsValue = p.value_gets_variant.Exists(this_Value)
End Function
Public Function LacksValue(ByVal this_Value As WdColorIndex) As Boolean
LacksValue = Not Me.HoldsValue(this_Value)
End Function
Public Function HoldsName(ByVal this_name As Variant) As Boolean
HoldsName = p.variant_gets_value.Exists(this_name)
End Function
Public Function LacksName(ByVal this_name As Variant) As Boolean
LacksName = Not Me.HoldsName(this_name)
End Function
Public Function Count() As Long
Count = p.value_gets_variant.Count
End Function
Public Function DicOfValueGetsName() As Scripting.Dictionary
Set DicOfValueGetsName = p.value_gets_variant
End Function
Public Function DicOfNameGetsValue() As Scripting.Dictionary
Set DicOfNameGetsValue = p.variant_gets_value
End Function
Private Function ReverseDictionary(ByRef this_dictionary As Scripting.Dictionary, Optional this_dictionary_name As String = vbNullString) As Scripting.Dictionary
' Swaps keys for Names in scripting.dictionaries.
' Keys and Names must be unique
Dim my_key As Variant
Dim my_keys As Variant
Dim my_reversed_dictionary As Scripting.Dictionary
Dim my_message As String
On Error GoTo key_is_not_unique
Set my_reversed_dictionary = New Scripting.Dictionary
my_keys = this_dictionary.Keys
For Each my_key In my_keys
Debug.Print this_dictionary.Item(my_key)
my_reversed_dictionary.Add _
Key:=this_dictionary.Item(my_key), _
Item:=my_key
Next
Set ReverseDictionary = my_reversed_dictionary
Exit Function
key_is_not_unique:
On Error GoTo 0
If Len(this_dictionary_name) = 0 Then
my_message = vbNullString
Else
my_message = " in dictionary '" & this_dictionary_name & "' "
End If
my_message = "The key '" & my_key & "'is not a unique value" & my_message
msgbox _
Title:="Reverse Dictionary Error", _
prompt:=my_message, _
Buttons:=vbOKOnly
Set ReverseDictionary = Nothing
End Function
完成此操作后，您现在可以将修改后的代码更新为
Option Explicit
Public colors As New wdColourIndexGetsName
Private Sub cmd_Run_Click()
Dim sFind As String
Dim sColor As String
Selection.HomeKey wdStory
sFind = Input_Search_Term.Value
sColor = Input_Color.Value
Debug.Print GetColorValue(sColor) ' for testing, and it prints the numeric color number
Do Until Selection.Find.Found = False
Selection.Range.HighlightColorIndex = colors.Value(sColor)
Selection.MoveRight
Selection.Find.Execute
Loop
End Sub
Private Sub UserForm_Initialize()
' Makes the assumption that Input_Color is a List box
Input_Color.List = colors.Names
End Sub
此类很好地说明了OO代码的优点。现在，您编写代码不再需要了解什么是颜色。
要获取wdColorIndex枚举的名称，只需使用
this_colour_name = colors.Name(wdRed)
反之亦然
this_colour_enum = colors.Value("Red")
“名称和值”属性分别返回颜色的字符串名称的变体数组和颜色的枚举值。这意味着现在可以轻松遍历枚举或字符串值。
Dim my_names() as variant
Dim my_name as variant
my_names = colors.names
For each my_name in my_names
<other code>
Next
如果您对以上代码有任何疑问，请给我发消息，否则，请您好运。