Проблема, с которой вы сталкиваетесь, является распространенной в VBA, поскольку язык не поддерживает рефлексию.Это означает, что для перечислений мы не можем сказать, например.
wdTurquoise.ToString
и получить возвращаемое значение строки "wdTurquoise".
Эту проблему можно решитьдовольно просто, создав новый класс, который инкапсулирует перечисление, с которым вы работаете.Я довольно часто использую такие классы и называю их словарями обратного просмотра.Я создал класс для управления wdColorIndex, а код приведен ниже.
Код требует, чтобы вы перешли в Tools.References и отметили флажок «Microsoft Scripting Runtime», потому что класс полагается на «сценарии».словарь (улучшенная версия VBA, встроенная в «Collection»).
Добавьте новый модуль класса и назовите его «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
Этот класс хорошо иллюстрирует преимущество ОО-кода.Теперь вашему коду больше не нужно ничего знать о том, что такое цвет.
Чтобы получить имя перечисления wdColorIndex, вы просто используете
this_colour_name = colors.Name(wdRed)
и наоборот
this_colour_enum = colors.Value("Red")
Свойства Names и Values возвращают вариантные массивы имен строк цветов и значений перечисления цветов соответственно.Это означает, что теперь легко перебирать перечисление или строковые значения.
Dim my_names() as variant
Dim my_name as variant
my_names = colors.names
For each my_name in my_names
<other code>
Next
Если у вас есть какие-либо вопросы по поводу приведенного выше кода, пожалуйста, напишите мне, в противном случае удачи в ваших начинаниях.