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 listbox = ne pas copier mais bien déplacer l'élément [XL-2016]


Sujet :

Macros et VBA Excel

  1. #1
    Nouveau membre du Club
    Inscrit en
    Août 2008
    Messages
    89
    Détails du profil
    Informations forums :
    Inscription : Août 2008
    Messages : 89
    Points : 36
    Points
    36
    Par défaut Drag and drop listbox = ne pas copier mais bien déplacer l'élément
    Bonjour,

    Je suis tombé sur ce post de AlphaScorpi :

    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    Public LaListBox As String
    Dans un module de classe : ClListBoxs

    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
    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
    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
    Ceci fonctionne à merveille au détail prêt que le choix 1 est copié-collé et non drag and drop, sous entendu

    1. si je drag&drop "choix 1" de listbox1 à listbox2 j'ai "choix 1" dans listbox1 et listbox2
    2. 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
    3. 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 les par 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)

    Merci de votre aide belle journée à vous

  2. #2
    Nouveau membre du Club
    Inscrit en
    Août 2008
    Messages
    89
    Détails du profil
    Informations forums :
    Inscription : Août 2008
    Messages : 89
    Points : 36
    Points
    36
    Par défaut
    J'ai ajouté ce bout de code (qui me permet également de trier les valeurs par ordre alphabétique) à la fin de "Private Sub GroupListBoxs_BeforeDropOrPaste" du module de classe ClListBoxs:

    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
    Dim i As Long, j As Long, strTemp As String, Ctrl As Control
     
        For Each Ctrl In UserForm1.Controls
     
            If Ctrl.Name = LaListBox Then Ctrl.RemoveItem (Ctrl.ListIndex)
     
            If Left$(Ctrl.Name, 7) = "ListBox" Then
                With Ctrl
                    For i = 0 To .ListCount - 1
                        For j = 0 To .ListCount - 1
                            If .List(i) < .List(j) Then
                                strTemp = .List(i)
                                .List(i) = .List(j)
                                .List(j) = strTemp
                            End If
                        Next j
                    Next i
                End With
            End If
     
        Next Ctrl

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Désactiver le drag and drop mais autoriser le copier/coller
    Par JohnSn dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 06/07/2016, 20h13
  2. Réponses: 0
    Dernier message: 09/10/2012, 18h48
  3. Drag and Drop ListBox -> HTML
    Par babar93 dans le forum Silverlight
    Réponses: 1
    Dernier message: 02/12/2009, 21h22
  4. Drag and Drop & listbox
    Par DarioP dans le forum Windows Forms
    Réponses: 6
    Dernier message: 10/11/2009, 16h55
  5. Drag and Drop entre listbox
    Par zwoke dans le forum C++Builder
    Réponses: 2
    Dernier message: 05/07/2004, 15h10

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