Drag and drop listbox = ne pas copier mais bien déplacer l'élément
Bonjour,
Je suis tombé sur ce post de AlphaScorpi :
Citation:
Je suis passé par un module de classe pour faire la meme chose qu'avec deux listbox mais avec un nombre indeterminé de ListBox
Alors dans un premier temps, dans un module
Code:
Public LaListBox As String
Dans un module de classe : ClListBoxs
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
| Option Explicit
Public WithEvents GroupListBoxs As MSForms.ListBox
Private Sub GroupListBoxs_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)
If LaListBox = GroupListBoxs.Name Then Exit Sub
Cancel = True
Effect = 1
End Sub
Private Sub GroupListBoxs_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)
If LaListBox = GroupListBoxs.Name Then Exit Sub
Cancel = True
Effect = 1
GroupListBoxs.AddItem Data.GetText
End Sub
Private Sub GroupListBoxs_MouseMove(ByVal Button As _
Integer, ByVal Shift As Integer, ByVal X As _
Single, ByVal Y As Single)
Dim MyDataObject As DataObject
LaListBox = GroupListBoxs.Name
If Button = 1 Then
Set MyDataObject = New DataObject
Dim Effect As Integer
If IsNull(GroupListBoxs) Then Exit Sub
MyDataObject.SetText GroupListBoxs.Value
Effect = MyDataObject.StartDrag
End If
End Sub |
Et avec l'USF
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
| Option Explicit
Dim CollectLstBox As Collection
Dim mLstBox As ClListBoxs
Private Sub UserForm_Initialize()
Dim Ctl As Control
Dim i As Integer
For i = 1 To 10
ListBox1.AddItem "Choice " _
& (ListBox1.ListCount + 1)
Next i
Set CollectLstBox = New Collection
For Each Ctl In Me.Controls
If TypeOf Ctl Is MSForms.ListBox Then
Set mLstBox = New ClListBoxs
Set mLstBox.GroupListBoxs = Ctl
CollectLstBox.Add mLstBox
End If
Next
End Sub |
Ceci fonctionne à merveille au détail prêt que le choix 1 est copié-collé et non drag and drop, sous entendu
- si je drag&drop "choix 1" de listbox1 à listbox2 j'ai "choix 1" dans listbox1 et listbox2
- si je réitère drag&drop "choix 1" de listbox1 à listbox2 j'ai "choix 1" dans listbox1 et 2 fois "choix 1" dans listbox2
- si je drag&drop "choix 1" de listbox2 à listbox1 j'ai 2 fois "choix 1" dans listbox1 et 2 fois "choix 1" dans listbox2
En remplaçant les par dans le module de classe le fonctionnement copier/coller perdure alors que je souhaite que choix 1 soit bel et bien déplacé de listbox1 à listbox2 puis éventuellement de listbox2 à listbox1. (le raisonnement doit pouvoir fonctionner quel que soit le nombre de listbox)
Merci de votre aide belle journée à vous
