[XL-2010] Aide sur Drag and drop entre x ListBox

J'ai lu cette discussion.

bonjour alpha scorpi
ce truc m'intéresse, mais n'étant pas un grand spécialiste vba, je ne peux que noter le bug à la ligne du module de classe :
Set MyDataObject = New DataObject >>>> utilisation incorrecte du mot clé NEW
j'utilise Office 2010 avec windows7(32bits) (sur macbookpro + parallels desktop)
si quelqu'un peut me dépanner sachant que j'ai 10 ListBox nommées ListBox1 à ListBox10 et que le but c'est de faire des drag and drop depuis et vers n'importe quelle ListBox
merci

Citation:

Envoyé par AlphaScorpi

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