@all

eigentlich bleibt mir der "Nährwert" eines Makro für eine Aktion, wo locker über Menübenutzung zu schaffen verborgen, aber

es lädt zum Spielen ein

Option Explicit

Sub Variante()
Dim oWsh As Worksheet
Dim mStr As String
Dim x As Long

Dim oRng As Range
Dim ToDo As Range
Dim mCol As Variant

  Set oWsh = ActiveSheet
  Set oRng = Selection
  mStr = oRng.Text
  Sheets.Add After:=Sheets(Sheets.Count)
  
  Application.ScreenUpdating = False
    
  For x = 1 To Len(mStr)
    On Error Resume Next
    Cells(1, x).Interior.ColorIndex = x
    On Error GoTo 0
    With Cells(2, x)
      .NumberFormat = "@"
      .Font.Size = 12
      .Font.Bold = True
      .Formula = Mid(mStr, x, 1)
    End With
  Next x
  
  Range(Columns(1), Columns(x)).AutoFit
  Range(Columns(x), Columns(Columns.Count)).Hidden = True
  Range(Rows(3), Rows(Rows.Count)).Hidden = True
  Application.DisplayFormulaBar = Not Application.DisplayFormulaBar
  With ActiveWindow
    .DisplayVerticalScrollBar = Not .DisplayVerticalScrollBar
    .DisplayWorkbookTabs = Not .DisplayWorkbookTabs
    .DisplayHeadings = Not .DisplayHeadings
  End With
  
  Application.ScreenUpdating = True
  On Error GoTo errorhandler
  
  Set ToDo = Application.InputBox(prompt:= _
    "Markiere eine der oben angezeigten Farben" & Chr(13) & _
    "mit der Maus und klick OK", _
    Title:="Schritt 1 - Farbe wählen", Type:=8)
  
  mCol = ToDo.Interior.ColorIndex
  
  Do
  Set ToDo = Application.InputBox(prompt:= _
    "Markiere die oben angezeigten Textteile" & Chr(13) & _
    "mit der Maus und klick OK" & Chr(13) & Chr(13) & _
    "oder wenn fertig, Abbrechen", _
    Title:="Schritt 2 - Schleife für Text wählen", Type:=8)
  
  ToDo.Font.ColorIndex = mCol
  oRng.Characters(ToDo.Cells(1).Column, ToDo.Cells.Count).Font.ColorIndex = mCol
  Loop
 
errorhandler:
  Application.DisplayAlerts = Not Application.DisplayAlerts
  ActiveSheet.Delete
  Application.DisplayAlerts = Not Application.DisplayAlerts
  oWsh.Select
  Application.DisplayFormulaBar = Not Application.DisplayFormulaBar

End Sub