[VBA-E]drag and drop entre deux listbox

Version imprimable

11/04/2007, 13h19
Yolak

[VBA-E]drag and drop entre deux listbox
Bonjour!

Voici mon problème (bien que bien résumé dans le sujet):

J'ai deux listbox dans deux userform différentes:
Code:

1 2 UserForm3.ListBox1 UserForm4.ListBox2
Je voudrais déplacer un objet de la ListBox1 vers la ListBox2 par la méthode "drag and drop"

J'ai cherché sur le site et le forum mais j'ai pas franchement trouvé ce que je voulais (suis tombé sur du c++, des appli access et tout et tout mais rien qui puisse m'aider... Ou alors faut vraiment que j'arrête de fumer des trucs bizarres!!)

Comment dois-je faire svp???
11/04/2007, 14h01
ouskel'n'or

Quand tu veux limiter une recherche au forum VBA, tu dois le sélectionner dans la fenêtre "Chercher dans les forums..." ;)
12/04/2007, 10h14
Yolak

Même en procédant ainsi je ne trouve rien (suis-je si bête???:roll: )

Si vous pouviez me donner un lien vers un tutos ou un sujet qui parle de ça ce serait bien gentil :)

PS: merci pour le conseil tout de même ;)
12/04/2007, 11h23
ouskel'n'or

Comme je n'ai jamais fait ça, et donc que c'est un terrain de jeu nouveau pour moi... ça m'intéresse. Je suis donc allé dans l'aide (F1) et après quelques périgrinations, je suis d'abord tombé sur DataObject puis, de fil en aiguille sur
ListBox, contrôle, DataObject, objet, MouseMove, événement, StartDrag, SetText, méthodes, exemple
Là, un exemple indique comment faire un glisser/coller d'un listbox à l'autre situés tous deux dans le même userform. J'en suis là :(
Je sais que ça ne répond pas à ta question mais c'est pour te montrer qu'on ne te laisse pas tomber comme ça ;)
12/04/2007, 13h47
Yolak

Oui je pense que c'est par là que je pourrais trouver ce que je cherchais ;)

Merci beaucoup!!! :yaisse2:
25/04/2007, 11h10
Yolak

En fait l'exemple qui est donné est vraiment bien mais seulement s'il y a 2 listbox...
Or moi j'en ai 4 et l'utilisateur doit pouvoir faire un drag and drop sur n'importe quelle listbox...
En partant de l'exemple ça fait un code de 12 milliard de lignes lol
Il doit bien exister une méthode pour limiter le code!

Quelqu'un aurait-il une idée?
25/04/2007, 11h16
ouskel'n'or

Tu nous les montres ces 12 milliards de lignes ?
A défaut, montre-nous celui pour deux textbox, on verra ce qu'on peut faire... sans engagement ;)

Citation:

Tu nous les montres ces 12 milliards de lignes ?

lol non je ne les ai pas tapées!!!

Voici l'exemple de l'aide dont nous parlons:

Citation:

ListBox, contrôle, DataObject, objet, MouseMove, événement, StartDrag, SetText, méthodes, exemple

L'exemple suivant illustre une opération glisser-déplacer à partir d'un contrôle ListBox vers un autre, à l'aide d'un objet DataObject contenant le texte déplacé. Le code utilise les méthodes SetText et StartDrag dans l'événement MouseMove pour réaliser l'opération glisser-déplacer.

Pour utiliser cet exemple, copiez le code suivant dans la partie Déclarations d'une feuille et vérifiez que celle-ci contient deux contrôles ListBox nommés ListBox1 et ListBox2. Vous devez également ajouter des choix dans le second contrôle ListBox.
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 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 UserForm_Initialize() For i = 1 To 10 ListBox1.AddItem "Choice " _ & (ListBox1.ListCount + 1) Next i End Sub
Je dois faire la même chose mais j'ai 4 listbox

Bon je suis tombé sur ce vieux sujet en cherchant une solution à un probleme que je rencontre.

Je crois avoir une solution, sait on jamais, ça pourrait etre utile à quelqu'un =)

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:

1
2
 
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
45
46
 
 
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
25
26
 
 
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