Hallo Markus,
das Programm geht etwas einfacher, da eine Kontrolleinrichtung nicht erforderlich ist:
l = Len(ActiveCell.Offset(0, b).Value)
ReDim Farbe(l)
For i = 1 To l
Farbe(i) = ActiveCell.Offset(0, b).Characters(i, 1).Font.ColorIndex
Next i
k = Len(ActiveCell.Offset(1, b).Value)
ReDim Preserve Farbe(l + k)
For j = 1 To k
Farbe(l + j) = ActiveCell.Offset(1, b).Characters(j, 1).Font.ColorIndex
Next j
ActiveCell.Offset(0, b).Value = (ActiveCell.Offset(0, b).Value & " / " & ActiveCell.Offset(1, b).Value)
For i = 1 To l
ActiveCell.Characters(i, 1).Font.ColorIndex = Farbe(i)
Next i
For i = 1 To k
ActiveCell.Characters(l + 3 + i, 1).Font.ColorIndex = Farbe(l + i)
Next i
For i=1 to 3
ActiveCell.Characters(l + i, 1).Font.ColorIndex = 1
Next i
Hoffentlich klappt es. Sonst melde dich wieder
Frohes Fest
Holger
Holger schrieb am 23.12.2007 10:06:27:
Hallo Markus,
leider kenne ich keine eingache Methode. Ich schlage deshalb vor, sich für die Ausgangszelle und die hinzuzufügende Zelle vor dem Zusammenfügen alle Farbindizes in ein Array zu schreiben und nach dem Zusammenfügen die Indizes aus diesem Array zurückzusetzen. Dabei musst du beachten, dass du auch Leerzeichen und einen Schrägstrich eingefügt hast. Diese Zeichen setze ich hier auf schwarz.
l = Len(ActiveCell.Offset(0, b).Value)
ReDim Farbe(l)
For i = 1 To l
Farbe(i) = ActiveCell.Offset(0, b).Characters(i, 1).Font.ColorIndex
a = a + Str(Farbe(i)) + vbCrLf
Next i
k = Len(ActiveCell.Offset(1, b).Value)
ReDim Preserve Farbe(l + k)
For j = 1 To k
Farbe(l + j) = ActiveCell.Offset(1, b).Characters(j, 1).Font.ColorIndex
a = a + Str(Farbe(l + j)) + vbCrLf
Next j
ActiveCell.Offset(0, b).Value = (ActiveCell.Offset(0, b).Value & " / " & ActiveCell.Offset(1, b).Value)
For i = 1 To l
ActiveCell.Characters(i, 1).Font.ColorIndex = Farbe(i)
Next i
For i = 1 To k
ActiveCell.Characters(l + 3 + i, 1).Font.ColorIndex = Farbe(l + i)
Next i
For i=1 to 3
ActiveCell.Characters(l + i, 1).Font.ColorIndex = 1
Next i
Hoffentlich klappt es. Sonst melde dich wieder
Frohes Fest
Holger
Markus schrieb am 19.12.2007 11:14:39:
Hallo,
per VBA kopiere ich den Inhalt der Zeile x+1Zelle für Zelle in die Zeile x. Also z.B. den inhalt der Zelle A2 in die Zelle A1. Die Zelle A1 ist jedoch nicht leer und der Inhalt soll erhalten bleiben. Das kopieren mache ich so:
ActiveCell.Offset(0, b).Value = (ActiveCell.Offset(0, b).Value & " / " & ActiveCell.Offset(1, b).Value)
Das funktioniert soweit auch. In der Zelle A1 ist jedoch teilweise eine unterschiedliche Texxtfarbe gewählt- also steht in A 1 Text in Grün und Blau (in der Reihenfolge) und in A2 Pinker Text.
Kopiere ich auf diese weise ist danach der gesamte Text Grün. Wie kann ich zumindest den Ursprungstext in den Originalfarben erhalten?
Weis jemand Rat? |