Sub
WörterAusExcel()
Dim
WB
As
Object
Set
WB = GetObject(ThisDocument.Path &
"\" & "
Wd Xl Ute.xlsx")
Farbe = Array(255, 65535)
lr = WB.sheets(1).Cells(10000,
"A"
).
End
(xlup).Row
For
j = 1
To
2
For
i = 1
To
lr
With
ActiveDocument.Range.Find
.Text = WB.sheets(1).Cells(i, j)
.Replacement.Font.Color = Farbe(j - 1)
.Execute Replace:=wdReplaceAll
End
With
Next
i
Next
j
End
Sub