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