Drag and Drop

[ranswrt]

I am trying to learn how to drag an item from one textbox to another textbox.
I copied this code for the help menu:

Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _
MSForms.ReturnBoolean, ByVal Data As _
MSForms.DataObject, ByVal X As Single, _
ByVal Y As Single, ByVal DragState As Long, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)
Cancel = True
Effect = 1
End Sub

Private Sub ListBox2_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, 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
ListBox2.AddItem Data.GetText
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
Dim MyDataObject As DataObject
If Button = 1 Then
Set MyDataObject = New DataObject
Dim Effect As Integer
MyDataObject.SetText ListBox1.Value
Effect = MyDataObject.StartDrag

End If
End Sub

Private Sub ListBox2_Change()

End Sub

Private Sub UserForm_Initialize()
For i = 1 To 10
ListBox1.AddItem "Choice " _
& (ListBox1.ListCount + 1)
Next i
End Sub
Private Sub ListBox2_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
Dim MyDataObject As DataObject
If Button = 1 Then
Set MyDataObject = New DataObject
Dim Effect As Integer
MyDataObject.SetText ListBox1.Value
Effect = MyDataObject.StartDrag

End If
End Sub

How do I get it to remove the selected item from the first textbox after it
is added to the second textbox?

Thanks

 

[Norman Jones]

Hi Ranswrt,

You speak of TextBox controls, but your
code relates to ListBox controls.

Assuming this to be a slip of the tongue,
try replacing your ListBox2_BeforeDropOrPaste
routine with the following adaptation:


'==========>>
Private Sub ListBox2_BeforeDropOrPaste(ByVal _
Cancel As MSForms.ReturnBoolean, _
ByVal Action As Long, _
ByVal Data As MSForms.DataObject, _
ByVal X As Single, _
ByVal Y As Single, _
ByVal Effect As MSForms.ReturnEffect, _
ByVal Shift As Integer)

Dim arrOut As Variant
Dim sStr As String
Dim i As Long, j As Long

Cancel = True
Effect = 1
sStr = Data.GetText
ListBox2.AddItem sStr

With Me.ListBox1
ReDim arrOut(0 To .ListCount - 2)
For i = 0 To .ListCount - 1
If .List(i) <> sStr Then
arrOut(j) = .List(i)
j = j + 1
End If
Next i
.Clear
.List = arrOut
End With
End Sub
'==========>>



---
Regards.
Norman

@discussions.microsoft.com> wrote in message
news:[email protected]...