noch ein UNGETESTER Versuch:
'Makro in Word-Datei
Sub WörterAusExcel()
dim WB as object
set WB = GetObject(Pfad & File) 'die xl-Datei
Farbe = Array(12345, 15686, 20000, 25000, 30000, 35000, 40000, 45000, 50000, 55000, 2500, 5000)
lr = WB.sheets(1).cells(rows.count, "A").end(xlup).row
for j = 1 to 12 'Spalten der xl-Liste
for i = i to lr 'Zeilen der xl-Liste
With ActiveDocument.Range.Find
.Text = WB.sheets(1).cells(i,j)
.Replace.Font.Color = Farbe(j-1)
.Execute Replace:=wdReplaceAll
end with
next i
next j
End sub
_____________________________________
Notwendige Anpassungen:
Die Farbcodes
der Pfad und Name der xl-Datei
um feedback wird gebeten
|