Steuerung der Anzeige einer Textbox durch Zeilenauswahl

[schauan]

Hallo Sotaros,

das Leeren eines Eintrages könntest Du so vornehmen:

Code:

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Variablendeklaration
'Variant-Array
Dim arrZeilen1, arrZeilen2
'Text der textboxen 1 und 2 anhand der Zeilenenden splitten
arrZeilen1 = Split(TextBox1, vbLf)
'aktuellen Eintrag loeschen
arrZeilen1(TextBox1.CurLine) = ""
'geaenderten Inhalt zurueckschreiben
TextBox1 = Join(arrZeilen1, vbLf)
End Sub

Es gibt nun jedoch ein Problem mit meinem code. Wenn Du in Textbox1 auf eine geleerte Zeile drückst, dann wird irgend was davor markiert. Das könntest Du mit dieser codezeile verhindern - später noch was dazu, warum nicht:

Code:

'Markieren bei leerer Zeile verhindern
If arrZeilen1(TextBox1.CurLine) = Chr(13) Then Exit Sub

Jetzt ist allerdings die Frage, was passieren soll, wenn in beiden Textboxen die gleiche Zeile Leer ist... Willst Du den Doppelklick als "Schalter" für diese Zeile der Textbox - Text einfügen / löschen? Wenn die Textboxen ganz leer sind, müsstest Du ggf. 10x doppelklicken und dabei immer eine leere Zeile erwischen, bis die wieder voll ist

Der "Schalter" würde so aussehen. Der code muss jedoch in das MouseUp-Ereignis, da das Doppelklick-Ereignis seltsamerweise nur dann wirkt, wenn Du damit einen Eintrag triffst. Damit bin ich jetzut dem "später noch was dazu ...". Statt der oben geposteten "Verhinderungszeile" nimmst Du diesen code hier.

Code:

'Wenn der Eintrag / die Zeile leer ist, dann
If  arrZeilen1(TextBox1.CurLine) = Chr(13) Then
  'aktuellen Eintrag aud Spalte A holen
  arrZeilen1(TextBox1.CurLine) = Cells(TextBox1.CurLine+1, 1)
  'Uebernahme des Array in textbox1 mit Zeillentrenner vblf
  Textbox1 = Join(arrZeilen1, vbLf)
'Ende Wenn der Eintrag / die Zeile leer ist, dann
End If

Entweder kannst Du innerhalb des If dann das Makro verlassen oder Du lässt es weiterlaufen, dann wird der EIntrag noch markiert.

Übrigens ist es mir bisher nur ein mal gelungen, dass Doppelklick-Ereignis ohne das MouseUp-Ereignis auszulösen ... Das MouseUp greift vor dem Doppelklick, denn bereits beim ersten Klick geht die Taste ja wieder hoch.

[sotaros]

Hallo Andre,
danke schon mal für die Funktionserweiterung. Deinen Code werde ich nachher oder morgen testen.
Nochmal: Dein Code und der von Uwe arbeiten zur vollsten Zufriedenheit und nochmal auch es geht
mir hier vor allem um den Code selbst und neue Sachen kennenzulernen. Deine Verschachtelung
von gestern war schon so eine Sache und die Textboxauffüllung von Uwe mit der Transponierung
ebenfalls. Super.
Muss jetzt leider weiter arbeiten.

Ausgehend von Uwe's Code habe ich dann auch schon mal etwas herumgeschraubt:

Code:

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim vArray(1 To 2) As Variant
vArray(1) = Split(TextBox1.Value, vbLf)
vArray(2) = Split(TextBox2.Value, vbLf)
vArray(2)(TextBox1.CurLine) = ""
vArray(1)(TextBox1.CurLine) = ""
TextBox1 = Join(vArray(1), vbLf)
TextBox2 = Join(vArray(2), vbLf)
End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim vArray(1 To 2) As Variant
vArray(1) = Split(TextBox1.Value, vbLf)
vArray(2) = Split(TextBox2.Value, vbLf)
vArray(2)(TextBox2.CurLine) = ""
vArray(1)(TextBox2.CurLine) = ""
TextBox1 = Join(vArray(1), vbLf)
TextBox2 = Join(vArray(2), vbLf)
End Sub

[schauan]

Hallo sotaros,

das Problem mit dem Click / MouseUp und dem Doppelclick lässt sich übrigens auch noch lösen, dauert aber etwas.

[schauan]

Hallo sotaros,

das wäre jetzt der code für die Klicks und Doppelklicks auf die Textbox1.

Code:

Dim isEvent As Boolean

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Kontrollwert für Verhinderungen setzen
isEvent = False
'Variablendeklaration
'Variant-Array
Dim arrZeilen1
'Text der textboxen 1 und 2 anhand der Zeilenenden splitten
arrZeilen1 = Split(TextBox1, vbLf)
'aktuellen Eintrag loeschen
arrZeilen1(TextBox1.CurLine) = ""
'Inhalt zurueckschreiben
TextBox1 = Join(arrZeilen1, vbLf)
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Variablendeklaration
'Variant-Array
Dim arrZeilen1, arrZeilen2
'Single
Dim sTime As Single
'Kontrollwert für Verhinderungen setzen
isEvent = True
'Zeit fuer eventuell weitere Tastenbewegug der Maus aufnehmen
sTime = Timer
'Schleife fuer Pruefung auf Doppelklick / 0,5s auf Eingabe warten
Do
  'Steuerung an System uebergeben
  DoEvents
  'Wenn das Doppelklickereignis ausgelöst wurde, dann Sub verlassen
  If Not isEvent Then Exit Sub
  'The next test accounts for clicks just before midnight.
'Ende Schleife fuer Pruefung auf Doppelklick fuer 0,5 Sekunden
Loop Until Timer > sTime + 0.5 Or Timer < sTime
'Text der textboxen 1 und 2 anhand der Zeilenenden splitten
arrZeilen1 = Split(TextBox1, vbLf)
arrZeilen2 = Split(TextBox2, vbLf)
'Array fuer Textboxen auf 10 Elemente setzen.
'Falls in der textbox 10 (Leer-) Zeilen enthalten sind, ist das nicht noetig!
ReDim Preserve arrZeilen1(0 To 9)
ReDim Preserve arrZeilen2(0 To 9)
'Wenn der Eintrag / die Zeile leer ist, dann
'Hinweis: Or nur wegen eventuell "jungfraulicher" Textbox
If arrZeilen1(TextBox1.CurLine) = Chr(13) Or arrZeilen1(TextBox1.CurLine) = "" Then
  'aktuellen Eintrag aud Spalte A holen
  arrZeilen1(TextBox1.CurLine) = Cells(TextBox1.CurLine + 1, 1)
  'Uebernahme des Array in textbox2 mit Zeillentrenner vblf
  TextBox1 = Join(arrZeilen1, vbLf)
  'Makro verlassen
  Exit Sub
'Ende Wenn der Eintrag / die Zeile leer ist, dann
End If
'Start der Markierung berechnen, Trennung hier anhand erstem Auftreten des textes der angeklickten Zeile
TextBox1.SelStart = Len(Split(TextBox1, arrZeilen1(TextBox1.CurLine))(0)) - TextBox1.CurLine
'Länge anhand der Textlänge der angeklickten Zeile
TextBox1.SelLength = Len(arrZeilen1(TextBox1.CurLine))
'Hinweis: Die Markierung wird nur dann exakt gesetzt, wenn der Text der Zeile in der Box nicht doppelt vorkommt.
'Uebernahme des Array in textbox2 mit Zeillentrenner vblf
TextBox2 = Join(arrZeilen2, vbLf)
End Sub

[Kuwer]

Hallo,

zur Demonstration der Events einer TextBox habe ich mal etwas gebastelt (ist noch ausbaufähig).
Man kann schön sehen, dass es doch kompliziert werden kann, verschiedene Events unter einen Hut zu bekommen.
Erschwerend kommt hinzu, dass es zu unerwartetem Verhalten kommen kann, z.B beim Rechtsklick.

Gruß Uwe

[sotaros]

Hallo Andre,

irgendetwas stimmt mit deinem Code noch nicht. Bitte überprüfe das nochmal.

[sotaros]

Hallo Uwe,

danke für die interessanten Upload.

Anbei eine Lösung mit dem Doppelklick basierend auf deinem Code.

Code:

Private Sub UserForm_Activate()
  TextBox1 = Join(Application.Transpose(Range("A1:A10").Value), vbLf)
  TextBox2 = String(9, vbLf)
End Sub
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim vArray(1 To 2) As Variant
  vArray(1) = Application.Transpose(Range("B1:B10").Value)
  vArray(2) = Split(TextBox2.Value, vbLf)
  vArray(2)(TextBox1.CurLine) = vArray(1)(TextBox1.CurLine + 1)
  TextBox2 = Join(vArray(2), vbLf)
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim vArray(1 To 2) As Variant
vArray(1) = Split(TextBox1.Value, vbLf)
vArray(2) = Split(TextBox2.Value, vbLf)

If Not (vArray(1)(TextBox1.CurLine)) = Chr(13) Then
vArray(1)(TextBox1.CurLine) = ""
vArray(2)(TextBox1.CurLine) = ""
Else
vArray(1)(TextBox1.CurLine) = Range("A" & TextBox1.CurLine + 1).Value
End If
TextBox1 = Join(vArray(1), vbLf)
TextBox2 = Join(vArray(2), vbLf)


End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim vArray(1 To 2) As Variant
vArray(1) = Split(TextBox1.Value, vbLf)
vArray(2) = Split(TextBox2.Value, vbLf)
If Not (vArray(2)(TextBox2.CurLine)) = Chr(13) Then
vArray(2)(TextBox2.CurLine) = ""
vArray(1)(TextBox2.CurLine) = ""
Else
vArray(1)(TextBox2.CurLine) = Range("A" & TextBox2.CurLine + 1).Value
vArray(2)(TextBox2.CurLine) = Range("A" & TextBox2.CurLine + 1).Value
End If

TextBox1 = Join(vArray(1), vbLf)
TextBox2 = Join(vArray(2), vbLf)

End Sub

1. Das kann man vom Code besser machen
2. Außerdem funktioniert blendet der Code per Doppelklick die letzte Zeile 10 nicht ein.
Ansonsten funktioniert es ganz gut.
Vielleicht könntest du hier noch mal etwas "retuschieren"

[sotaros]

Kleine verbesserte Version, die letzte Zeile kommt so beim Doppelklick auch wieder,
trotzdem könnte der Code nochmal überarbeitet werden:

Code:

Private Sub UserForm_Activate()
  TextBox1 = Join(Application.Transpose(Range("A1:A10").Value), vbLf)
  TextBox2 = String(9, vbLf)
End Sub
Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim vArray(1 To 2) As Variant
  vArray(1) = Application.Transpose(Range("B1:B10").Value)
  vArray(2) = Split(TextBox2.Value, vbLf)
  vArray(2)(TextBox1.CurLine) = vArray(1)(TextBox1.CurLine + 1)
  TextBox2 = Join(vArray(2), vbLf)
  Debug.Print TextBox1.CurLine
End Sub
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim vArray(1 To 2) As Variant
vArray(1) = Split(TextBox1.Value, vbLf)
vArray(2) = Split(TextBox2.Value, vbLf)
Debug.Print TextBox1.CurLine
If Not (vArray(1)(TextBox1.CurLine)) = Chr(13) Then
vArray(1)(TextBox1.CurLine) = Chr(13)
vArray(2)(TextBox1.CurLine) = Chr(13)

Else
vArray(1)(TextBox1.CurLine) = Range("A" & TextBox1.CurLine + 1).Value
End If
TextBox1 = Join(vArray(1), vbLf)
TextBox2 = Join(vArray(2), vbLf)


End Sub
Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim vArray(1 To 2) As Variant
vArray(1) = Split(TextBox1.Value, vbLf)
vArray(2) = Split(TextBox2.Value, vbLf)
If Not (vArray(2)(TextBox2.CurLine)) = Chr(13) Then
vArray(2)(TextBox2.CurLine) = Chr(13)
vArray(1)(TextBox2.CurLine) = Chr(13)
Else
vArray(1)(TextBox2.CurLine) = Range("A" & TextBox2.CurLine + 1).Value
vArray(2)(TextBox2.CurLine) = Range("A" & TextBox2.CurLine + 1).Value
End If

TextBox1 = Join(vArray(1), vbLf)
TextBox2 = Join(vArray(2), vbLf)

End Sub

[schauan]

Hallo zusammen,

ich habe nun mal versucht für die Textboxen auf dem Blatt das Beste aus der Milch zu machen

Ein Knackpunkt war u.a., dass fehlende Zeilen in den Textboxen zu ungewöhnlichem Verhalten bzw. Fehlern führen. Wenn der Anwender auf den Gedanken kommt, die Inhalte einer Textbox zu löschen, funktioniert es anschließend nicht mehr richtig - das habe ich hier durch das redim ... vermieden.
Außerdem hat Uwe die Textbox1 beim Aufruf des userform mit den Daten gefüllt - ich mach das jetzt bei Aktivierung des Arbeitsblattes. Dadurch funktioniert es bei mir jetzt auch in allen Zeilen richtig. Allerdings wird dadurch ein eventuell gespeicherter Stand beim Aktivieren überschrieben.

Den Doppelklick unterscheide ich nach wie vor durch die Variable auf Modulebene, den Timer und DoEvents usw. Wenn die Maus gedrückt wird, wird der MouseDown - code kurz unterbrochen. Während dieser Zeit kommt bei entsprechender Aktion noch das Doppelklickereignis, der Doppelklick-Code wird ausgeführt, die Variable wird dabei gesetzt, und deswegen dann der MouseDown - code verlassen.

Bei Doppelklick in Textbox1 wird der vorhandene Text gelöscht und der zugehörige Eintrag in Textbox2.
Bei Doppelklick in Textbox1 auf eine leere Zeile wird der Text eingetragen, die Textbox2 jedoch nicht verändert. Das erfolgt nur, wie anfangs verlangt, bei einem einfachen Klick. Allerdings wird der Text sowohl bei einfachem Klick als auch bei Wiedereintrag durch Doppelklick markiert.

Bei Doppelklick in Textbox2 wird nur der betroffene Eintrag gelöscht. Wiederhergestellt wird hier nichts.

Code:

Dim isEvent As Boolean

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Kontrollwert für Verhinderungen setzen
isEvent = False
'Variablendeklaration
'Variant-Array
Dim arrTBox1, arrTBox2
Debug.Print "DblClick" & TextBox1.CurLine
'Text der textboxen 1 und 2 anhand der Zeilenenden splitten
arrTBox1 = Split(TextBox1, vbLf)
arrTBox2 = Split(TextBox2, vbLf)
'sicherheitshalber redimensionieren - falls jemand Eintraege manuell geloescht hat
'Hinweis: Durch manuelles Loeschen kann die Position der Eintraege in den Textboxen fehlerhaft sein!
ReDim Preserve arrTBox1(0 To 9)
ReDim Preserve arrTBox2(0 To 9)
'aktuellen Eintrag wiederherstellen
If arrTBox1(TextBox1.CurLine) = Chr(13) Then
   arrTBox1(TextBox1.CurLine) = Cells(TextBox1.CurLine + 1, 1)
'... oder loeschen
Else
   arrTBox1(TextBox1.CurLine) = ""
   arrTBox2(TextBox1.CurLine) = ""
'Ende aktuellen Eintrag wiederherstellen
End If
'Inhalt zurueckschreiben
TextBox1 = Join(arrTBox1, vbLf)
TextBox2 = Join(arrTBox2, vbLf)
End Sub

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim vArray(1 To 2) As Variant, arrTBox1, arrTBox2
'Single
Dim sTime As Single
'Kontrollwert für Verhinderungen setzen
isEvent = True
'Zeit fuer eventuell weitere Tastenbewegug der Maus aufnehmen
sTime = Timer
'Schleife fuer Pruefung auf Doppelklick / 0,5s auf Eingabe warten
Do
  'Steuerung an System uebergeben
  DoEvents
  'Wenn das Doppelklickereignis ausgelöst wurde, dann Sub verlassen
  If Not isEvent Then Exit Sub
  'The next test accounts for clicks just before midnight.
'Ende Schleife fuer Pruefung auf Doppelklick fuer 0,5 Sekunden
Loop Until Timer > sTime + 0.5 Or Timer < sTime
Debug.Print "MouseDown" & TextBox1.CurLine
'Inhalte der Textboxen in Arrays uebernehmen
arrTBox1 = Split(TextBox1, vbLf)
arrTBox2 = Split(TextBox2, vbLf)
'sicherheitshalber redimensionieren - falls jemand die Eintraege geloescht hat
'Hinweis: Durch manuelles Loeschen kann die Position der Eintraege in den Textboxen fehlerhaft sein!
ReDim Preserve arrTBox1(0 To 9)
ReDim Preserve arrTBox2(0 To 9)
'Wenn der Eintrag / die Zeile leer ist, dann
'Hinweis: Or nur wegen eventuell "jungfraulicher" Textbox
If arrTBox1(TextBox1.CurLine) = Chr(13) Or arrTBox1(TextBox1.CurLine) = "" Then Exit Sub
arrTBox2(TextBox1.CurLine) = Cells(TextBox1.CurLine + 1, 2)
'Start der Markierung berechnen, Trennung hier anhand erstem Auftreten des textes der angeklickten Zeile
TextBox1.SelStart = Len(Split(TextBox1, arrTBox1(TextBox1.CurLine))(0)) - TextBox1.CurLine
'Länge anhand der Textlänge der angeklickten Zeile
TextBox1.SelLength = Len(arrTBox1(TextBox1.CurLine))
'Hinweis: Die Markierung wird nur dann exakt gesetzt, wenn der Text der Zeile in der Box nicht doppelt vorkommt.
'Uebernahme des Array in textbox2 mit Zeillentrenner vblf
TextBox2 = Join(arrTBox2, vbLf)
isEvent = False
End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'Variablendeklaration
'Variant-Array
Dim arrTBox2
Debug.Print "DblClick" & TextBox2.CurLine
'Text der textboxe2 anhand der Zeilenenden splitten
arrTBox2 = Split(TextBox2, vbLf)
'sicherheitshalber redimensionieren - falls jemand die Eintraege geloescht hat
'Hinweis: Durch manuelles Loeschen kann die Position der Eintraege in den Textboxen fehlerhaft sein!
ReDim Preserve arrTBox2(0 To 9)
'aktuellen Eintrag loeschen
arrTBox2(TextBox2.CurLine) = ""
'Inhalt zurueckschreiben
TextBox2 = Join(arrTBox2, vbLf)
End Sub

Private Sub Worksheet_Activate()
'Textboxen fuellen
TextBox1 = Join(Application.Transpose(Range("A1:A10").Value), vbLf)
TextBox2 = String(10, vbLf)
End Sub

[Kuwer]

Hallo André,

Außerdem hat Uwe die Textbox1 beim Aufruf des userform mit den Daten gefüllt - ich mach das jetzt bei Aktivierung des Arbeitsblattes.

Wie gehst Du da genau vor? Denn so wie Du es gepostet hast, geht es nicht bei mir. (Das Worksheet_Activate ist natürlich im Blatt.)

Gruß Uwe