Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Drag and Drop mit gleichzeitiger Positionierung
#1
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.
Antwortento top
#2
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
Antwortento top
#3
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
Antwortento top
#4
Hi Uwe,

yepp - kann man so verstehen!
Aber mal sehen, ob Kathrin das überhaupt noch liest Wink
Antwortento top
#5
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
Antwortento top
#6
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
Antwortento top
#7
Hallo Uwe,

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

Vielen, vielen Dank!!!!
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste