Ich habe eine solch ähnliche Frage erst kürzlich gestellt, komme aber nicht wirklich weiter bei dem jetzigen Problem:
Mit folgendem Code (hier aus dem Forum, danke Hajo!) erzwinge ich einen Zeilenumbruch nach 50 Zeichen und schreibe in der darunterliegenden Zelle weiter.
Jedoch fehlt mir aber noch folgendes, was muss noch eingefügt werden, wenn mit Shift+Enter in der Textbox ein Zeilenumbruch "erzwungen" wird und dieser dann ebenfalls in eine neue Zeile übergeben wird?
Hier mal der Code, den ich benutze:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then ' eine Zelle verändert
Dim LoZeile As Long ' Variable für Zeile
Dim StWert As String ' Variable für Zellinhalt
If Target = "" Then Exit Sub ' kein Inhalt in Zelle
' erste Zeile in die was geschrieben werden soll
LoZeile = Target.Row
' Zellinahlt auf die Variable schreiben
StWert = Target
If Not Target.HasFormula Then ' Eingabe ist keine Formel
If Target.Column = 6 Then ' nur für Spalte B (2)
' Zellinhalt länger als 50 Zeichen
If Len(StWert) > 50 Then
' Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
' Reaktion auf Zellveränderung abschalten
Application.EnableEvents = False
' Schleife für das Aufteilen
Do
If InStrRev(StWert, " ", 50) > 0 Then
' erste Leerstelle von rechts bis
' 50. Stelle ermitteln und den Teil
' in die Zelle schreiben
Cells(LoZeile, Target.Column) _
= Left(StWert, InStrRev(StWert, _
" ", 50))
' restlichen Zellinhalt
' auf Variable schreiben
StWert = Mid(StWert, _
InStrRev(StWert, " ", 50) + 1)
Else
' keine Leerstelle gefunden,
' 50 Stellen in Zelle schreiben
Cells(LoZeile, Target.Column) _
= Left(StWert, 50)
' restlichen Zellinhalt
' auf Variable schreiben
StWert = Mid(StWert, 51)
End If
' Zeilennummer um 1 erhöhen
LoZeile = LoZeile + 1
' Schleife verlassen
' falls Restzeichenkette
' kürzer als 50 Zeichen
Loop Until Len(StWert)
Vielen Dank für eure Hilfe!!!
Greetz Gegga