Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Mehrzeilige Textbox

Mehrzeilige Textbox
Gegga
Hallo da draussen...
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Mehrzeilige Textbox
08.09.2010 16:15:03
Gerd
Hallo G.
was hat der Code von Hajo mit einer Textbox zu tun?
Gruß Gerd
AW: Mehrzeilige Textbox
08.09.2010 16:26:00
Gegga
Hallo G
Ganz einfach der Eintrag aus meiner Textbox wirft den Code von Hajo an.
If Target.Column = 6 Then
Hier in dieser Spalte wird der Inhalt der Textbox eingetragen und nach 50 Zeichen umgebrochen respektive in darunterliegenden Zellen eingetragen.
Ich wollte jetzt nur wissen, wenn in meiner mehrzeiligen Textbox ein "gewollter" Zeilenumbruch eingefügt wird (Shift+Return) wie dieser dann berücksichtigt werden kann, also nicht nach 50 Zeichen sondern nach Shift+Return in die nächste Zelle eintragen...
Gruß G.
Anzeige
AW: Mehrzeilige Textbox
08.09.2010 20:19:44
Gerd
Hallo G.,
würde gerne wissen, weshalb das gute Excel als Textprogramm herhalten muss? :-)
Gruß Gerd
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
For IntIndex = 0 To Split(Target.Text, Chr(10))(UBound(Split(Target.Text, Chr(10))))
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) 

Anzeige
AW: Mehrzeilige Textbox
09.09.2010 05:18:15
Gegga
Guten Morgen Gerd
*lach* Der Grund hierfür ist, das ich die Textlänge nicht weiss und somit auch die Zellhöhe einwandfrei bestimmen kann, deshalb die Eintragungen in einzelne Zellen. Unddas Sheet "sieht" noch nach was aus und hat nicht lauter unterschiedliche Zellhöhen.
Aber zu deinem Code, danke erstmal das du mir hilfst...
Jedoch bekomme ich leider einen Laufzeitfehler (13) Typen unvertraglich in dieser Zeile:
For IntIndex = 0 To Split(Target.Text, Chr(10))(UBound(Split(Target.Text, Chr(10))))
Wenn ich in die Zelle schaue wo eingetragen wird, steht der Text mit den Umbrüchen drin, aber anstatt der Umbrüche in neue Zellen, steht da immer ein Viereckiges Kästchen.
Nen Rat parat?
Vielen Dank
Gruss Gerhard alias Gegga...
Anzeige
AW: Mehrzeilige Textbox
09.09.2010 08:32:30
fcs
Hallo Gegga,
mit folgenden Anpassungen sollte es prinzipiell funktionieren.
Ich konnte jetzt aber auf die Schnelle nicht prüfen, welches Zeichen (ggf. sind das auch 2) die Textboxen als Zeilenschaltung zurückgibt.
Gruß
Franz
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
Dim vSplit                          ' Variable für Textteile
Dim intIndex                        ' Schleifenzähler
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
'Text an Zeilenschaltung Trennen und in Array aufteilen
vSplit = Split(Target.Text, Chr(10)) ' oder Chr(13) ?
' Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
' Reaktion auf Zellveränderung abschalten
Application.EnableEvents = False
' Schleife für das Aufteilen
For intIndex = LBound(vSplit) To UBound(vSplit)
StWert = vSplit(intIndex)
If Len(StWert) > 50 Then
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) 

Anzeige
AW: Mehrzeilige Textbox
11.09.2010 06:34:06
Gegga
Danke Jogy
Allerdings bringt mich diese Variante nicht mehr weiter...
Das Prob ist ich müsste das auf versch Zellbereiche anwenden.
Und das hierfür umzustricken fehlt mir mein Wissen...
Zumal ich auch das Gefhl habe das dieser Code ewig "läuft"
Ich habe heute nochmals eine neue Frage gepostet und hoffe, das hiermit sämtliche Probs die ich habe erledigt sind
Nochmals Danke für deine fortwährende Hilfe!!!!!!
Gruß Gegga

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige