IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Drag and Drop entre 2 ListBox Multicolonnes


Sujet :

Macros et VBA Excel

  1. #1
    Membre habitué
    Profil pro
    Inscrit en
    Avril 2007
    Messages
    785
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 785
    Points : 182
    Points
    182
    Par défaut Drag and Drop entre 2 ListBox Multicolonnes
    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.

  2. #2
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 788
    Points
    1 788
    Par défaut
    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.

  3. #3
    Membre habitué
    Profil pro
    Inscrit en
    Avril 2007
    Messages
    785
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 785
    Points : 182
    Points
    182
    Par défaut
    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 ??

  4. #4
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 788
    Points
    1 788
    Par défaut
    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

  5. #5
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    12 855
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 12 855
    Points : 28 774
    Points
    28 774
    Billets dans le blog
    53
    Par défaut
    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.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  6. #6
    Membre habitué
    Profil pro
    Inscrit en
    Avril 2007
    Messages
    785
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 785
    Points : 182
    Points
    182
    Par défaut
    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é.

  7. #7
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 788
    Points
    1 788
    Par défaut
    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.

  8. #8
    Rédacteur
    Avatar de Philippe Tulliez
    Homme Profil pro
    Formateur, développeur et consultant Excel, Access, Word et VBA
    Inscrit en
    Janvier 2010
    Messages
    12 855
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur, développeur et consultant Excel, Access, Word et VBA

    Informations forums :
    Inscription : Janvier 2010
    Messages : 12 855
    Points : 28 774
    Points
    28 774
    Billets dans le blog
    53
    Par défaut
    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.
    Philippe Tulliez
    Ce que l'on conçoit bien s'énonce clairement, et les mots pour le dire arrivent aisément. (Nicolas Boileau)
    Lorsque vous avez la réponse à votre question, n'oubliez pas de cliquer sur et si celle-ci est pertinente pensez à voter
    Mes tutoriels : Utilisation de l'assistant « Insertion de fonction », Les filtres avancés ou élaborés dans Excel
    Mon dernier billet : Utilisation de la fonction Dir en VBA pour vérifier l'existence d'un fichier

  9. #9
    Membre régulier
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    47
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 47
    Points : 82
    Points
    82
    Par défaut re:proposition complete
    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
    '***************************************************************************************
    Nom : demo.gif
Affichages : 70
Taille : 132,0 Ko

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

    Pat

  10. #10
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 788
    Points
    1 788
    Par défaut
    @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.

  11. #11
    Membre régulier
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    47
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 47
    Points : 82
    Points
    82
    Par défaut re:argument discutable
    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
    Fichiers attachés Fichiers attachés

  12. #12
    Membre régulier
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    47
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 47
    Points : 82
    Points
    82
    Par défaut re:pour répondre à ta question (ajoute en une 3eme
    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
    Nom : demo.gif
Affichages : 67
Taille : 213,5 Ko

    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

  13. #13
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 788
    Points
    1 788
    Par défaut
    Au final, tu as écrit des délégués (soit: du code générique).

  14. #14
    Membre régulier
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    47
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 47
    Points : 82
    Points
    82
    Par défaut re
    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

  15. #15
    Membre habitué
    Profil pro
    Inscrit en
    Avril 2007
    Messages
    785
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 785
    Points : 182
    Points
    182
    Par défaut
    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.

    @+

  16. #16
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 788
    Points
    1 788
    Par défaut
    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()).

  17. #17
    Membre régulier
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    47
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 47
    Points : 82
    Points
    82
    Par défaut re
    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

  18. #18
    Membre habitué
    Profil pro
    Inscrit en
    Avril 2007
    Messages
    785
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 785
    Points : 182
    Points
    182
    Par défaut
    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.

  19. #19
    Membre régulier
    Homme Profil pro
    CIP
    Inscrit en
    Avril 2024
    Messages
    47
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : CIP
    Secteur : Service public

    Informations forums :
    Inscription : Avril 2024
    Messages : 47
    Points : 82
    Points
    82
    Par défaut re
    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

  20. #20
    Membre habitué
    Profil pro
    Inscrit en
    Avril 2007
    Messages
    785
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Avril 2007
    Messages : 785
    Points : 182
    Points
    182
    Par défaut
    Ouaffffffffffff décoiffant,

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

    Re merci @+

Discussions similaires

  1. [XL-2010] Aide sur Drag and drop entre x ListBox
    Par jacky72 dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 23/05/2014, 23h32
  2. [VBA-E]drag and drop entre deux listbox
    Par Yolak dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 14/06/2012, 14h37
  3. Drag and drop entre deux ListBox
    Par simoinfonet dans le forum Langage
    Réponses: 0
    Dernier message: 18/04/2008, 18h53
  4. [FLASH MX2004] Drag and drop entre deux List
    Par aldo-tlse dans le forum Flash
    Réponses: 15
    Dernier message: 24/09/2005, 01h10
  5. Drag and Drop entre listbox
    Par zwoke dans le forum C++Builder
    Réponses: 2
    Dernier message: 05/07/2004, 14h10

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo