Bonjour,
Je suis tombé sur ce post de AlphaScorpi :
Ceci fonctionne à merveille au détail prêt que le choix 1 est copié-collé et non drag and drop, sous entenduJe 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
Dans un module de classe : ClListBoxs
Code : Sélectionner tout - Visualiser dans une fenêtre à part Public LaListBox As String
Et avec l'USF
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
- 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 lespar
Code : Sélectionner tout - Visualiser dans une fenêtre à part Effect = 1
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)
Code : Sélectionner tout - Visualiser dans une fenêtre à part Effect = 2
Merci de votre aide belle journée à vous
Partager