Discussion :

[modus57]

Bonsoir le forum,

Dans un UserForm j'ai 2 Listbox, j'effectue un glisser déplacer entre les 2.

Jusqu'ici ça va, pas de souci.

En revanche là où ça se complique, c'est que mes ListBox sont multicolonnes et je n'arrive pas à glisser déplacer l'ensemble de la ligne.

Bien sûr si je crée un premier Tableau1 de 2 colonnes et un deuxième Tableau2 d'une colonne qui contient la concaténation des 2 colonnes du Tableau1 et que j'alimente la ListBox1 avec le Tableau1, ça peut-être une solution.

Existe-t-il une autre méthode qui permet d'éviter cette astuce.

Merci par avance pour votre aide.

[deedolith]

Salut,

Avec un listbox multicolumn, la propriété ListIndex te donne l'index de la ligne sélectionnée, tu peux l'utiliser pour transmettre:
1) Soit l'intégralité des des données:

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
Private Sub MyListBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim DataObject As msforms.DataObject
 
    If Button = xlPrimaryButton Then
        With MyListBox
            If (.ListIndex >= 0) Then
                    '// construit une chaîne JSON avec l'intégralité des données
                Dim Json As String
                Json = "{"
 
                Dim i As Long
                For i = 0 To .ColumnCount - 1
                    Json = Json & """Column" & i & """: "
                    Json = Json & """" & .List(.ListIndex, i) & """"
                    If (i < (.ColumnCount - 1)) Then
                        Json = Json & ", "
                    End If
                Next
                Json = Json & "}"
                Set DataObject = New msforms.DataObject
                DataObject.SetText Json
                DataObject.StartDrag fmDropEffectMove
            End If
        End With
    End If
End Sub

2) Soit le minimum vital, a charge du contrôle ciblé de reconstruire les données:

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
Private Sub MyListBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim DataObject As msforms.DataObject
 
    If Button = xlPrimaryButton Then
        With MyListBox
            If (.ListIndex >= 0) Then
                    '// construit une chaîne JSON le minimum vital (la propriété ListIndex)
                Dim Json As String
                Json = "{""Index"" : " & .ListIndex & "}"
                Set DataObject = New msforms.DataObject
                DataObject.SetText Json
                DataObject.StartDrag
            End If
        End With
    End If
End Sub

Les exemples passent par une chaîne Json pour représenter les données, ce n'est pas obligatoire, fait ce qui te convient le mieux.

[modus57]

Bonjour deedolith,

J'ai intégré vos 2 solutions de code dans l'UserForm qui contient 2 ListBox de 2 colonnes mais lors du Drag and Trop il se passe rien dans la deuxième ListBox ??

[deedolith]

Faute de code, ca va être difficile de t'aider.

De plus, je n'ai donné que des exemples, en aucun cas tu ne dois les copier / coller sans réfléchir, mais les adapter à ton cas particulier dont, au vue des informations que tu nous as donné, on ne sais pas grand chose.

Si je reformule la question que tu as posé: "Comment connaitre les données du contrôle source ?"
La réponse est: "Via la propriété ListIndex".
Le mode de transmission (encodeage / décodage) est complètement à ton initiative.

Visiblement, tu sais déjà comment implémenter du drag & drop, traiter les données sur les évènements du contrôle cible ne devrait pas te poser de problème.
S'il te faut un parser Json, j'en ai un en beta-test sur mon GitHub: https://github.com/Deedolith/JSON-VBA

[Philippe Tulliez]

Bonjour,
Personnellement, je n'ai aucun problème pour délacer plusieurs colonnes d'un ListBox à l'autre mais j'utilise des CommandButton
Sans publier le code que vous utilisez avec succès sur une liste à une colonne, on ne pourra pas vous aider.

[modus57]

Bonsoir P. TULLIEZ, deedolith,

Voici le code de mon UserForm sur la base du lien https://learn.microsoft.com/en-us/of...t-methods-exam

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
Private Sub UserForm_Initialize()
    Me.ListBox1.List = Range("Tableau1").Value
End Sub
 
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

Ma première ListBox1 contient de 2 colonnes et comme je l'explique dans mes précédents messages je souhaiterai faire un Drag and Drop dans la ListBox2 de la ligne complète.

Avec mon code le Drag and Drop dans la ListBox2 ne copie que la première colonne du tableau structuré.

[deedolith]

Tu as tout ce qu'il faut.

Comme je te l'ai indiqué précédemment, le secret c'est la propriété ListIndex.
Elle te permet de récupérer l'index de l'item sélectionné dans la listbox source, ainsi que les valeurs des différentes colonnes via la propriété List.
Dans l'évènement MouseMove, tu n'as plus qu'a encoder les données dans l'instance de la classe DataObject via la méthode SetText.
Dans l'évènement BeforeDropOrPaste les récupérer dans l'instance de la classe DataObject via la méthode GetText, les décoder pour enfin pouvoir ajouter ton item.

A toi de choisir quels données tu vas transmettre, et comment tu vas les encoder / décoder.

[Philippe Tulliez]

Bonjour,
La fonction générique que j'ai écrite, basée comme l'a indiqué deedolith sur la propriété ListIndex et qui fonctionne aussi bien avec la procédure double clic qu'avec des CommandButton ne peut s'adapter au code proposé de votre lien.

[patmeziere]

Bonjour à tous
en effet il y a moult façons de faire
la première bien évidemment dite orthodoxe est d'utiliser les events sine qua none
voici un exemple avec deux listbox multi colonnes ou l'on peut glisser de l'une dans l'autre et vise et versa

une petite nuance cependant
contrairement a ce qui a été dit le gettext ici ne sera pas utilisé
alors en effet on a besoins du data object pour l'"Effect" mais c'est tout
donc il a été dit que l'index suffisait et c'est bien le cas dans l'exemple ci dessous

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Dim ObjList As MSForms.ListBox
Dim IndexB&
Private Sub UserForm_Activate()
    'POUR L'EXEMPLE JE REMPLI MA LISTBOX1 AVE UN TABLEAU STRUCTURE(3 colonnes
    ListBox1.List = Range("Tableau1").Value
End Sub
 
'                        ***************EVENTS POUR LA LISTBOX1*****************************
 
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Effect As Integer, DataObj As DataObject
    If Button = 1 Then
        IndexB = ListBox1.ListIndex
        Set ObjList = ListBox1: Set DataObj = New DataObject: Effect = DataObj.StartDrag
   End If
End Sub
 
Private Sub ListBox1_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 = 2
End Sub
 
Private Sub ListBox1_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 C%
    If ObjList.Name <> ListBox1.Name Then
        With ListBox1
            .AddItem
            For C = 0 To .ColumnCount - 1: .List(.ListCount - 1, C) = ObjList.List(IndexB, C): Next
        End With
        With ObjList: .RemoveItem .ListIndex: .ListIndex = -1: End With
    End If
End Sub
'*******************************************************************************************
 
 
'                              ***************EVENTS POUR LA LISTBOX2*****************************
Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Effect As Integer, DataObj As DataObject
    If Button = 1 Then
        IndexB = ListBox2.ListIndex
        Set ObjList = ListBox2: Set DataObj = New DataObject: Effect = DataObj.StartDrag
    End If
End Sub
 
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 = 2
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)
   Dim C%
   If ObjList.Name <> ListBox2.Name Then
        With ListBox2
            .AddItem
            For C = 0 To .ColumnCount - 1: .List(.ListCount - 1, C) = ObjList.List(IndexB, C): Next
        End With
        With ObjList: .RemoveItem .ListIndex: .ListIndex = -1: End With
    End If
End Sub
'***************************************************************************************

après j'ai une autre méthode moins orthodoxe si vous voulez sans le data object

Pat

[deedolith]

@patmeziere:
A mon avis, il vaut mieux passer par un DataObject, renseigné avec suffisement d'informations pour mettre à jour les sources de données qui alimentent les contrôles, histoire de minimiser les dépendances.
Une fois les sources de données à jour, il ne reste plus qu'a rafraichir les contrôles.

[patmeziere]

Bonjour deedolith
cet argument est discutable dans le sens ou la listbox émettrice et dépendante de la listbox réceptrice car c'est elle qui relâche l'effect du data object
et vise et versa dans mon exemple
d'autre part concaténer les données de colonnes dans le settext puis le splitter dans l'autre pour refaire un array distribuable je ne sais pas si c'est bon

je suis sur que non d'ailleurs
en effet le split d'une chaine string donne des items string
a supposer que vous ayez des valeurs numériques voir avec décimale vous savez ce que fait vba avec les array de nombre (il arrondi parfois)

je vous laisse en tirer vos conclusion

juste pour le fun car vous semblez adepte du détournement d'event

comme dis un peu plus haut je vous propose cette méthode certes pas orthodoxe mais intéressante tout de même
ça devrait d'ailleurs vous mettre la puce à l'oreille pour votre topic sur les listbox item figé
ce qui ne gêne en rien sont fonctionnement normal

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
45
46
47
 
Option Explicit
Dim ObjList As MSForms.ListBox
Dim IndexB&
 
Private Sub UserForm_Activate()
'POUR L'EXEMPLE JE REMPLI MA LISTBOX1 AVE UN TABLEAU STRUCTURE(3 colonnes
    ListBox1.List = Range("Tableau1").Value
End Sub
 
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim C%
    If Button = 1 Then
        If IndexB > -1 And IndexB <> ListBox1.ListIndex Then ListBox1.ListIndex = IndexB
        IndexB = ListBox1.ListIndex
        Set ObjList = ListBox1
    ElseIf Button = 0 Then
        If Not ObjList Is Nothing And IndexB > -1 Then
            If ObjList.Name <> "ListBox1" Then
                ListBox1.AddItem
                For C = 0 To ListBox1.ColumnCount - 1: ListBox1.List(ListBox1.ListCount - 1, C) = ObjList.List(IndexB, C): Next
                ObjList.RemoveItem (IndexB)
                Set ObjList = Nothing
            End If
        End If
        IndexB = -1
    End If
End Sub
 
Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim C%
    If Button = 1 Then
        If IndexB > -1 And IndexB <> ListBox1.ListIndex Then ListBox2.ListIndex = IndexB
        IndexB = ListBox2.ListIndex
        Set ObjList = ListBox2
    ElseIf Button = 0 Then
        If Not ObjList Is Nothing And IndexB > -1 Then
            If Not ObjList.Name <> "ListBox1" Then
                ListBox2.AddItem
                For C = 0 To ListBox2.ColumnCount - 1: ListBox2.List(ListBox2.ListCount - 1, C) = ObjList.List(IndexB, C): Next
                ObjList.RemoveItem (IndexB)
                Set ObjList = Nothing
            End If
        End If
        IndexB = -1
    End If
End Sub

[patmeziere]

re
pour répondre a ton MP au sujet d'une éventuelle 3eme voir plus

et bien j'en ajoute même deux
comme je suis un peu fainéant je transforme les events (comme ça je ne récris pas 36 code identique pour chaque listbox
MouseMove , BeforeDropOrPaste en pseudo events commun en ajoutant un argument au début (le control)

c'est parti pour 4


voila le dataobject me sert toujours uniquement pour l'effect
qui est indissociable puisque c'est un des return en callback des events

le code

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
Dim ObjList As msforms.ListBox
Dim IndexB&
Private Sub UserForm_Activate()
'POUR L'EXEMPLE JE REMPLI MA LISTBOX1 AVE UN TABLEAU STRUCTURE(3 colonnes
    ListBox1.List = Range("Tableau1").Value
End Sub
 
'                        ***************EVENTS POUR LES LISTBOX *****************************
'LISTBOX1
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ListBox_MouseMove ListBox1, Button, Shift, X, Y
End Sub
Private Sub ListBox1_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 = 2
End Sub
Private Sub ListBox1_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)
    ListBox_BeforeDropOrPaste ListBox1, Cancel, Action, Data, X, Y, Effect, Shift
End Sub
 
 
'LISTBOX2
Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ListBox_MouseMove ListBox2, Button, Shift, X, Y
End Sub
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 = 2
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)
    ListBox_BeforeDropOrPaste ListBox2, Cancel, Action, Data, X, Y, Effect, Shift
End Sub
 
 
'LISTBOX3
Private Sub ListBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ListBox_MouseMove ListBox3, Button, Shift, X, Y
End Sub
Private Sub ListBox3_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 = 2
End Sub
Private Sub ListBox3_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)
    ListBox_BeforeDropOrPaste ListBox3, Cancel, Action, Data, X, Y, Effect, Shift
End Sub
 
 
'LISTBOX4
Private Sub ListBox4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ListBox_MouseMove ListBox4, Button, Shift, X, Y
End Sub
Private Sub ListBox4_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 = 2
End Sub
Private Sub ListBox4_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)
    ListBox_BeforeDropOrPaste ListBox4, Cancel, Action, Data, X, Y, Effect, Shift
End Sub
 
 
'                               EVENTS COMMUN
 
Private Sub ListBox_MouseMove(ByVal LstBox As msforms.ListBox, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Effect As Integer, DataObj As DataObject
    If Button = 1 Then
        IndexB = LstBox.ListIndex
        Set ObjList = LstBox: Set DataObj = New DataObject: Effect = DataObj.StartDrag
    End If
End Sub
 
'*******************************************************************************************
Private Sub ListBox_BeforeDropOrPaste(ByVal LstBox As msforms.ListBox, 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 C%
    If ObjList.Name <> LstBox.Name Then
        With LstBox
            .AddItem
            For C = 0 To .ColumnCount - 1: .List(.ListCount - 1, C) = ObjList.List(IndexB, C): Next
        End With
        With ObjList: .RemoveItem .ListIndex: .ListIndex = -1: End With
    End If
End Sub

voila comme on peut le voir 2 ou 3 ou 4 et même plus n'est pas un soucis
et je peux faire pareil avec la version gouigouik

[deedolith]

Au final, tu as écrit des délégués (soit: du code générique).

[patmeziere]

re


Si tu veux appeler ça comme ça oui pas de soucis
Je fait un copier coller de l'event
J'ajoute ma variable object control dans les arguments en byval ;je l'ai mis en premier
Et dans les vrai appels
J'appelle le délégué avec les return interger qui sont les mêmes dans le délégué avec le control explicite encodé dans l'apel

Autrement dit
ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub control1_vraievent(ByVal ceci As ReturnInteger, byvalcel As datatrucmuche, ByVal autrechose As long_ou_ce_que_tu_veux)
'blablabla tout le code pour l'intention
End Sub
Private Sub control2_vraievent(ByVal ceci As ReturnInteger, byvalcel As datatrucmuche, ByVal autrechose As long_ou_ce_que_tu_veux)
'blablabla tout le code pour l'intention
End Sub

' se transforme en cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub control1_vraievent(ByVal ceci As ReturnInteger, ByVal cela As datatrucmuche, ByVal autrechose As long_ou_ce_que_tu_veux)
control_eventCommun contol1, ceci, cela, autrechose
End Sub
Private Sub control2_vraievent(ByVal ceci As ReturnInteger, byvalcel As datatrucmuche, ByVal autrechose As long_ou_ce_que_tu_veux)
control_eventCommun contol2, ceci, cela, autrechose
End Sub
'pareil pour 
'control3
'control4
'etc...
 
Private Sub control_eventCommun(ByVal myControl As msforms.trucchouette, ByVal ceci As ReturnInteger, byvalcel As datatrucmuche, ByVal autrechose As long_ou_ce_que_tu_veux)
'blablabla un seul code  pour l'intention de tout les controls
End Sub

Alors comme ça n'a pas fait tilt quand je te l'ai suggéré un peu plus haut
Ton problème de sélection dans le drop drag pour ta listbox avec figée sert toi en juste pour figer dans le drag puis que le mouse mouve a mémorisé l'index

voila

[modus57]

Bonjour,

Réponse tardive, car je me suis absenté depuis lundi.

Hé bien solution orthodoxe ou pas catholique, elles fonctionnent toutes, quand ça marche faut pas toucher.

Bravo et merci pour vos réponse et en particulier à patmeziere qui est le bienvenue.

À prime abord et compte tenu des informations glanées ci et là, le Drag and Trop fonctionne qu'avec les ListBox simple sélection, sauf si j'ai mal cherché ?

Bonne soirée.

@+

[deedolith]

Non non,
en multiselection ca fonctionne aussi.

L'implémentation diffère légèrement puisqu'on ne se base plus sur la valeur du contrôle, mais sur les éléments sélectionnés (propriété select()).

[patmeziere]

bonsoir à tous les deux
juste en passant
pour le multi select

tu sélectionne avec click gauche et tu drag avec bouton droit

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
45
46
47
48
49
50
51
52
53
Option Explicit
Dim ObjList As msforms.Listbox
 
Private Sub UserForm_Activate()
'POUR L'EXEMPLE JE REMPLI MA LISTBOX1 AVE UN TABLEAU STRUCTURE(3 colonnes
    ListBox1.List = Range("Tableau1").Value
End Sub
 
'*************************************************************************
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ListBox_MouseMove ListBox1, Button, Shift, X, Y
End Sub
Private Sub ListBox1_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 = 2
End Sub
Private Sub ListBox1_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)
    ListBox_BeforeDropOrPaste ListBox1, Cancel, Action, Data, X, Y, Effect, Shift
End Sub
 
'***************************************************************************
Private Sub ListBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ListBox_MouseMove ListBox2, Button, Shift, X, Y
End Sub
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 = 2
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)
    ListBox_BeforeDropOrPaste ListBox2, Cancel, Action, Data, X, Y, Effect, Shift
End Sub
'************************************************************************************************
 
 
Private Sub ListBox_MouseMove(ByVal LstBox As msforms.Listbox, ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Dim Effect As Integer, dataobj As DataObject
    If Button = 2 Then
        Set ObjList = LstBox: Set dataobj = New DataObject: Effect = dataobj.StartDrag
    End If
End Sub
Private Sub ListBox_BeforeDropOrPaste(ByVal LstBox As msforms.Listbox, 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 C%, I&
    With LstBox
        For I = 0 To ObjList.ListCount - 1
            If ObjList.Selected(I) = True Then
                .AddItem
                For C = 0 To .ColumnCount - 1: .List(.ListCount - 1, C) = ObjList.List(I, C): Next
                DoEvents
            End If
        Next
    End With
    For I = ObjList.ListCount - 1 To 0 Step -1
        If ObjList.Selected(I) Then ObjList.RemoveItem (I)
    Next
End Sub

[modus57]

Bonjour patmeziere, deedolith

C'est vraiment sympa et agréable une telle participation et réactivité.

Cette dernière solution multi-sélection, elle est super, manque un tri alphabétique dans chaque ListBox pour qu'elle soit nickel chrome.

Bon dimanche.

[patmeziere]

Bonjour Modus57

pas bien compliqué
tu veux quoi de préférence
le tri à bulle
le quick sort multicolonne
le tri fusion
le tri par sélection
c'est au choix

[modus57]

Ouaffffffffffff décoiffant,

J'ai ajouté la fonction de tri alpha et maintenant c'est parfait

Re merci @+