Добавление большего количества цветов в vba excel

Question

Это мой готовый продукт для поиска и выделения кода, он отлично работает, но я хочу больше цветов для моего кода. Я хочу, чтобы другой InputBox всплывал после SearchString = InputBox(Prompt:="What word would you like to highlight?") спрашивая, какой цвет вы хотите слово выделить в.

Sub Sample() 
Dim oRange As Range, aCell As Range, bCell As Range 
Dim ws As Worksheet 
Dim ExitLoop As Boolean 
Dim SearchString As String, Foundat As String 
Dim iCount() As String 
Dim outws As Worksheet 

Set ws = Worksheets("detail_report") 

Set oRange = ws.Cells 


SearchString = InputBox(Prompt:="What word would you like to highlight?") 

Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _ 
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
      MatchCase:=False, SearchFormat:=False) 

If Not aCell Is Nothing Then 
    Set bCell = aCell 
    Foundat = aCell.Address 
    Do While ExitLoop = False 
     Set aCell = oRange.FindNext(After:=aCell) 

     If Not aCell Is Nothing Then 
      If aCell.Address = bCell.Address Then Exit Do 
      Foundat = Foundat & ", " & aCell.Address 
     Else 
      ExitLoop = True 
     End If 
    Loop 

iCount = Split(Foundat, ", ") 

Set outws = Worksheets("output") 
    outws.Range("A1").Value = "Word" 
    outws.Range("B1").Value = "Count" 
    outws.Range("A2").Value = SearchString 
    outws.Range("B2").Value = UBound(iCount) + 1 

    End If 

Dim cellRange As Range 
Set cellRange = oRange.Find(What:=SearchString, LookIn:=xlValues, _ 
       LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False) 

If Not cellRange Is Nothing Then 


Foundat = cellRange.Address 

Do 

    Dim textStart As Integer 
    textStart = 1 

    Do 

     textStart = InStr(textStart, LCase(cellRange.Value), LCase(SearchString)) 
     If textStart <> 0 Then 
      cellRange.Characters(textStart, Len(SearchString)).Font.Color = RGB(255, 255, 0) 
      textStart = textStart + 1 
     End If 


    Loop Until textStart = 0 


    Set cellRange = oRange.FindNext(After:=cellRange) 

Loop Until cellRange Is Nothing Or cellRange.Address = Foundat 
Else 
    MsgBox SearchString & " not Found" 


End If 

End Sub 

Answer 1

Если бы я был ты, я бы создать пользовательский элемент управление с выпадающим списком, в дополнении к вашему вопросу «Какое слово вы хотели бы выделить». Вместо использования двух стандартных приглашений InputBox по умолчанию.

Однако быстрый и простой подход - просто настроить другой InputBox и запросить цвет. Затем используйте оператор «switch case» для проверки правильности ввода. Вы можете повторно запросить пользователя, если они ввели не поддерживаемое значение, или просто использовать значение по умолчанию.

'I like to use UCASE to standarize the case of the user's input 
ColorString = UCASE(InputBox("What color would you like to use?")) 

'Set Default Color 
color = RGB(0,255,255) 

select case ColorString 
    case "RED" 
     color = RGB(255,0,0) 
    case "GREEN" 
     color = RGB(0,255,0) 
    case "BLUE" 
     color = RGB(0,0,255) 
end select 

«Теперь установите ячейку, когда вы найдете свои матчи в вашем предыдущем алгоритме

cellRange.Interior.Color = цвет