AW: Textbox-Inhalt in Tabelle eintragen
21.10.2012 19:22:38
fcs
Hallo Wolfgang,
Fließtext in einer Textbox zeilenweise am Zeilenwechsel jeweils in einer neuen Zelle eintragen, das ist mir zu mühselig zu programmieren.
Ich kann dir anbieten, jeweils an einer Zeilenschaltung den Text in die nächste Zelle zu schreiben.
In der Tabelle2 formatierst du die Spalte1 dann so das Text automatisch umgebrochen wird und die Breite der Spalte stellst du etwa auf die Breite der Textbox ein.
Gruß
Franz
'Code in einem allgemeinen Modul oder wahlweise auch unter dem Tabellenmodul mit der Textbox
Option Explicit
Sub Eintragen(ByVal strText As String, _
ByVal rngZelle As Range, _
Optional ByVal strSep As String = " ", _
Optional bolSpalte As Boolean = True)
'Fügt gemäß gewählter Option den Text in mehrere Zellen ein, beginnend in rngZelle
Dim arrText
'Bei Zeilenschaltung als Trennzeichen muss in der Textbox ggf erst die Zeichenfolge _
Zeilenschaltung + Wagenrücklauf durch das Trennzeichen ersetzt werden.
If strSep = Chr(10) Or strSep = Chr(13) Then
If InStr(1, strText, Chr(13) & Chr(10)) > 0 Then
strText = VBA.Replace(strText, Chr(13) & Chr(10), strSep)
End If
End If
arrText = Split(strText, strSep)
With rngZelle.Parent
If bolSpalte = True Then
.Range(rngZelle, .Cells(rngZelle.Row + UBound(arrText), rngZelle.Column)) = _
Application.WorksheetFunction.Transpose(arrText)
Else
.Range(rngZelle, .Cells(rngZelle.Row, rngZelle.Column + UBound(arrText))) = arrText
End If
End With
End Sub
Sub TextLoeschen(ByVal rngZelle As Range, _
Optional bolSpalte As Boolean = True)
'Löscht in der Zeile oder Spalte alle Inhalte beginnend in rngZelle
Dim LetzterEintrag As Long
With rngZelle.Parent
If bolSpalte = True Then
LetzterEintrag = .Cells(.Rows.Count, rngZelle.Column).End(xlUp).Row
If LetzterEintrag >= rngZelle.Row Then
.Range(rngZelle, .Cells(LetzterEintrag, rngZelle.Column)).ClearContents
End If
Else
LetzterEintrag = .Cells(rngZelle.Row, .Columns.Count).End(xlToLeft).Column
If LetzterEintrag >= rngZelle.Column Then
.Range(rngZelle, .Cells(rngZelle.Row, LetzterEintrag)).ClearContents
End If
End If
End With
End Sub
'Code unter dem Tabellenmodul mit der Textbox
Option Explicit
'Welche der beiden Ereignisprozeduren man verwendet ist ein wenig Geschmackssache.
'TextBox1_Change aktualisert die Tabellendaten nach jeder Zeicheneingabe, _
TextBox1_LostFocus immer dann wenn man den Cursor wieder außerhalb der Textbox plaziert
Private Sub TextBox1_Change()
With Worksheets("Tabelle2")
Call TextLoeschen(rngZelle:=.Range("A1"))
Call Eintragen(strText:=Me.TextBox1.Value, rngZelle:=.Range("A1"), strSep:=Chr(10))
End With
End Sub
Private Sub TextBox1_LostFocus()
With Worksheets("Tabelle2")
Call TextLoeschen(rngZelle:=.Range("A1"))
Call Eintragen(strText:=Me.TextBox1.Value, rngZelle:=.Range("A1"), strSep:=Chr(10))
End With
End Sub