AW: Makro Format übertragen-Schriftfarbe erhalten
25.03.2009 10:12:31
D.Saster
Hallo,
In einer Zelle können bei knapp 70 Zeichen bis zu 3 Farben vorkommen.
das ist grob.
Da fällt mir nur ein, die Formate jeder Zelle einzeln zu übertragen und sich vorher die Farbe jedes einzelnen Zeichens zu merken. Das dauert.
Muster:
Function TextColors(rng As Range)
Dim i As Integer, vntColors
ReDim vntColors(1 To Len(rng))
For i = 1 To Len(rng)
vntColors(i) = rng.Characters(i, 1).Font.ColorIndex
Next
TextColors = vntColors
End Function
Sub tt()
Dim arrColors()
Dim wksVorlage As Worksheet, wksZiel As Worksheet
Dim iRow As Long, iCol As Long, i As Integer
Application.ScreenUpdating = False
Set wksVorlage = Sheets("Vorlage")
Set wksZiel = Sheets("Tabelle2")
For iRow = 100 To 1000
For iCol = 1 To 13
If Len(wksZiel.Cells(iRow, iCol)) > 0 Then
arrColors = TextColors(wksZiel.Cells(iRow, iCol))
End If
wksVorlage.Cells(iRow, iCol).Copy
wksZiel.Cells(iRow, iCol).PasteSpecial xlFormats
If Len(wksZiel.Cells(iRow, iCol)) > 0 Then
For i = 1 To Len(wksZiel.Cells(iRow, iCol))
wksZiel.Cells(iRow, iCol).Characters(i, 1).Font.ColorIndex = arrColors(i)
Next
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Gruß
Dierk