AW: Textdarstellung, Zeilenumbruch über mehrere Zellen
18.08.2004 17:11:02
joel
hallo andi
sorry, dass ich mich erst jetzt wieder melde. hab heut viel um die ohren
Sub TextInZellenSchreiben()
Dim sText As String
Dim lPos As Long 'position in sText
Dim c As Range 'zelle, in die text geschrieben werden soll
Dim lTextLaenge As Long 'länge des noch zu schreibenden textes
'text auslesen
sText = CStr(Tabelle1.Range("A1").Value)
'erste zelle, in die text geschrieben werden soll auslesen und löschen
Set c = Tabelle1.Range("A2")
c.ClearContents
For lPos = 1 To Len(sText)
'nächstes zeichen in zelle schreiben
c.Value = c.Value & Mid(sText, lPos, 1)
'NEU: falls zeilenumbruch erfolgt, letztes wort in nächste zelle schreiben
If TextUmbruch(c:=c) = True Then
'inhalt der folgenden zelle löschen
c.Offset(1, 0).ClearContents
'prüfen, ob ein leerzeichen (oder ähnliches) in der zelle enthalten ist
If InStr(c.Value, " ") >= 1 Or _
InStr(c.Value, "-") >= 1 Or _
InStr(c.Value, "/") >= 1 Then
' - falls ja: text bis zum letzten leerzeichen (oder ähnliches) in
' die nächste zelle schreiben
Do While (Right(c.Value, 1) Like "[ -/]" = False)
c.Offset(1, 0).Value = Right(c.Value, 1) & c.Offset(1, 0).Value
c.Value = Left(c.Value, Len(c.Value) - 1)
Loop
' - falls nein: nur letztes zeichen in nächste zelle schreiben
Else
c.Offset(1, 0).Value = Right(c.Value, 1)
c.Value = Left(c.Value, Len(c.Value) - 1)
End If
Set c = c.Offset(1, 0)
End If
Next lPos
End Sub
gruss joel