Drag and Drop mit gleichzeitiger Positionierung

[kathrin-Flint]

Ziehen von Wörtern per Drag and Drop und positionieren an die richtige Stelle.



Hallo meine lieben VBA Experten,

ich habe folgendes Programmierproblem:

In meiner Userform befinden sich die beiden Textboxen, Textbox1 und Textbox2. In beiden Textboxen steht die Eigenschaft DragBehavior auf fmDragBehaviorEnabled. Ich kann also Inhalte aus der Textbox1 markieren und per Drag and Drop in die Textbox2 ziehen. Nehmen wir an wir haben in der Textbox1 folgenden Beispielsatz stehen:

Pfingsten ist leider auch schon fast wieder vorbei.

Per Drag and Drop ziehe ich jetzt das wort "fast" in die Textbox2. Dann möchte ich als Ergebnis folgende haben:

Für TextBox1:
Aus dem Originalsatz:
Pfingsten ist leider auch schon fast wieder vorbei.
wird:
Pfingsten ist leider auch schon      wieder vorbei.

In TextBox2 steht dann das Wort:
                                        fast

und zwar genau an der Position, wo es vorher im Originalsatz stand.


Ich hoffe ihr könnt mir helfen und bedanke mich schon mal für eure Unterstützung.

[{Boris}]

Hi,

probier mal:

Beide Textboxen mit einer Nichtproportionalschrift versehen - z.B. Courier New.
Außerdem in einem ALLGEMEINEN Modul folgende mappenweite Variabe definieren:

Code:

Public lngStart As Long

Und für deine beiden Textboxen im Userform:

Code:

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
lngStart = TextBox1.SelStart
End Sub

Private Sub TextBox2_Enter()
Dim str As String
str = Me.TextBox2.Text
TextBox2 = ""
TextBox2 = String(lngStart, " ") & str
End Sub

[Kuwer]

Hi Boris,

ich verstehe das so, dass in TB1 der ausgeschnittene Text durch Leerzeichen ersetzt werden soll.

Code:

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 lngStart = TextBox1.SelStart
End Sub

Private Sub TextBox2_Enter()
 TextBox2 = String(lngStart, " ") & TextBox2
 TextBox1 = Left(TextBox1, lngStart) & String(Len(TextBox1.SelText), " ") & Mid(TextBox1, lngStart + Len(TextBox1.SelText) + 1)
End Sub

Gruß Uwe

[{Boris}]

Hi Uwe,

yepp - kann man so verstehen!
Aber mal sehen, ob Kathrin das überhaupt noch liest

[kathrin-Flint]

Lieber Boris, lieber Uwe,

vielen Dank schon mal für eure Hilfe. (Aufgrund leichter Zugangsprobleme kann ich mich leider erst jetzt melden).

Der Code den Uwe gebaut hat, funktioniert wie gewohnt super. Die Courier-Schrift habe ich schon in meine User Form eingebaut. Damit die ganze Sache wie gewünscht funktionert brauche ich noch etwas Hilfe.

1. Bei gedrückter Steuerungstaste soll der Text (wie normal bei Drag and Drop auch) in der Textbox1 stehen bleiben und nur eine Kopie der Auswahl in Textbox2 erscheinen.

2. ebenfalls sehr wichtig: Es soll möglich sein Text aus der TextBox1 nacheinander per Drag and Drop in TextBox2 zu ziehen.
Das heißt die getroffene Auswahl aus TextBox1 addiert sich Stück für Stück dann wieder in TextBox2.

Ich hoffe Uwe, du hast hier noch einmal mit deinem fast unschlagbarem Expertenwissen noch einmal ein Herz.
Vielen Dank schon mal im voraus.


Grüße
Kathrin

[Kuwer]

Hallo Kathrin,

die Variablen sind jetzt mit im Modul der UserForm. Es wird also kein extra Modul benötigt.

Code:

Option Explicit

Dim lngAZ As Long, lngStart As Long
Dim strCM As String


Private Sub TextBox1_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
 lngStart = TextBox1.SelStart
End Sub

Private Sub TextBox2_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
 Cancel = True
 Effect = 1
 strCM = Data.GetText
 lngAZ = Len(strCM)
 If Shift <> 2 Then
   TextBox1.Text = Application.Replace(TextBox1.Text, lngStart + 1, lngAZ, String(lngAZ, " "))
 End If
 With TextBox2
   If Len(TextBox1.Text) > Len(.Text) Then
     .Text = .Text & String(Len(TextBox1.Text) - Len(.Text), " ")
   End If
   .Text = Application.Replace(.Text, lngStart + 1, lngAZ, strCM)
 End With
End Sub

Gruß Uwe

[kathrin-Flint]

Hallo Uwe,

du bist einfach der Größte. Habe gerade deinen Code ausprobiert und das  funktioniert schon mal super!!

Vielen, vielen Dank!!!!