Option Explicit
Sub TestString()
Const T_STR As String = "invalid Englisch Dutch German Japanese Mandarin"
Dim language() As String, lenArr() As Long, colArr() As Double
Dim c As Range
Dim x As Long, lngStart As Long, lngBreak As Long
language = Split(T_STR)
ReDim lenArr(UBound(language)): ReDim colArr(UBound(language))
Set c = ActiveCell
c.Clear
For x = LBound(language) To UBound(language)
c.Value = language(x)
lngBreak = x
Select Case MsgBox("bestimme die Textfarbe zur Anzeige der aktiven Zelle ", vbOKCancel Or vbExclamation Or vbMsgBoxRight Or vbDefaultButton1, "Abfrage")
Case vbOK
colArr(x) = dlCol
Case vbCancel
Exit For
End Select
lenArr(x) = Len(language(x))
Next x
c.Value = Join(language, Chr(10))
lngStart = 1
For x = LBound(colArr) To lngBreak
c.Characters(lngStart, lenArr(x)).Font.Color = colArr(x)
lngStart = lngStart + lenArr(x) + 1
Next x
End Sub
Function dlCol() As Double
Dim oldcolor As Double
dlCol = ActiveWorkbook.Colors(1)
oldcolor = ActiveWorkbook.Colors(1)
If Application.Dialogs(xlDialogEditColor).Show(1) = True _
Then dlCol = ActiveWorkbook.Colors(1)
ActiveWorkbook.Colors(1) = oldcolor
End Function