wijzig taal:

Het instellen van drag en drop voor listboxen op een VBA formulier is niet heel eenvoudig en luistert erg nauw. Bij drag en drop spelen de volgende drie gebeurtenissen een rol: MouseMove, BeforeDragOver en BeforeDropOrPaste. De drag en drop wordt gestart in de MouseMove-gebeurtenis. De lijst-items die verplaatst of gekopieerd moeten worden, worden in een DataObject gekopieerd. Bij een juiste configuratie wordt het slepen met de muis afgehandeld door de BeforeDragOver-gebeurtenis. De daadwerkelijke drop wordt tenslotte afgehandeld door de BeforeDropOrPaste-gebeurtenis. Tijdens de drag en drop worden alle andere gebeurtenissen op het formulier uitgeschakeld.

instellen van listbox drag en drop

Om het instellen van drag en drop voor listboxen op een formulier heel eenvoudig te maken, wordt in dit artikel gewerkt met klassenmodules. Alle logica met betrekking tot de drag en drop is opgenomen in deze klassenmodules. Op dit manier kan door middel van het toevoegen slechts enkele regels code aan een formulier heel gemakkelijk drag en drop voor alle listboxen ingesteld worden. Op het formulier zelf hoeft verder niets aangepast te worden.

Eerst zal een beperkte basisopzet van deze opbouw aan de orde komen. Daarna volgt een geavanceerde veelzijdige uitwerking, waarbij de drag en drop heel nauwkeurig geconfigureerd kan worden per formulier. Van beide uitwerkingen kan een voorbeeld bestand gedownload worden.

Eenvoudige basisopzet

De basisopzet voor het instellen van drag en drop bestaat uit 2 klassenmodules. In de eerste klasse clDragDropForm wordt een koppeling gelegd naar het formulier. De andere klasse clDragDropListBox wordt gebruikt voor de afhandeling van de listbox gebeurtenissen. De code van klasse clDragDropForm is als volgt:

'--------------------------------------------------------------------------------------------------------------------------
' Auteur    : Manfred van den Noort
' Copyright : © 2020 worksheetsvba.com, alle rechten voorbehouden
' Datum     : 2020-12-07
' Versie    : 1.0
' Doel      : Instellen ListBox Drag & Drop Basis
'--------------------------------------------------------------------------------------------------------------------------

Private frmDragDrop As MSForms.UserForm
Private lstbxDragSource As MSForms.ListBox
Private colListBoxes As Collection

Private Sub Class_Initialize()
    Set colListBoxes = New Collection
End Sub

Friend Property Set DragDropForm(ByRef oFrm As Object)
    Set frmDragDrop = oFrm
End Property

Friend Property Set DragSource(ByRef oListBox As MSForms.ListBox)
    Set lstbxDragSource = oListBox
End Property

Friend Property Get DragSource()
    Set DragSource = lstbxDragSource
End Property

Friend Sub GetListboxes()
    Dim ctl As Control, oDragDropListBox As clDragDropListbox
    For Each ctl In frmDragDrop.Controls
        If TypeName(ctl) = "ListBox" Then
            Set oDragDropListBox = New clDragDropListbox
            With oDragDropListBox
                Set .ParentForm = Me
                Set .DragDropListBox = ctl
            End With
            colListBoxes.Add oDragDropListBox
        End If
    Next
End Sub

Friend Sub TerminateDragDrop()
    Set colListBoxes = Nothing
End Sub

Om op een formulier drag en drop voor de listboxen in te stellen, wordt van deze klasse met een paar regels code een instantie aangemaakt. Vanuit deze klasse worden dan automatisch de benodigde andere objecten van klasse clDragDropListBox aangemaakt. Dit is de code van klasse clDragDropListBox:

'--------------------------------------------------------------------------------------------------------------------------
' Auteur    : Manfred van den Noort
' Copyright : © 2020 worksheetsvba.com, alle rechten voorbehouden
' Datum     : 2020-12-07
' Versie    : 1.0
' Doel      : Instellen van ListBox Drag & Drop Basis
'--------------------------------------------------------------------------------------------------------------------------

Private oParentForm As clDragDropForm
Private WithEvents LstBx As MSForms.ListBox

Friend Property Set ParentForm(ByRef oValue As clDragDropForm)
    Set oParentForm = oValue
End Property

Friend Property Set DragDropListBox(ByRef oValue As MSForms.ListBox)
    Set LstBx = oValue
End Property

Private Sub LstBx_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 i As Long
    If oParentForm.DragSource Is LstBx Then Exit Sub
    Cancel = True
    Effect = fmDropEffectMove
    With LstBx
        .AddItem Data.GetText
        .ListIndex = .ListCount - 1
    End With
    With oParentForm.DragSource
        For i = .ListCount - 1 To 0 Step -1
            If .Selected(i) Then
                If .List(i) = Data.GetText Then
                    .RemoveItem i
                    Exit For
                End If
            End If
        Next i
        .ListIndex = -1
    End With
    LstBx.SetFocus
End Sub

Private Sub LstBx_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
    If oParentForm.DragSource Is LstBx Then
        Effect = fmDropEffectNone
    Else
        Effect = fmDropEffectMove
    End If
End Sub

Private Sub LstBx_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    Dim oDataObject As DataObject, lEffect As Long
    If Button = 1 Then
        If LstBx.Text = "" Then
            Exit Sub
        End If
        Set oDataObject = New DataObject
        oDataObject.SetText LstBx.Value
        Set oParentForm.DragSource = LstBx
        lEffect = oDataObject.StartDrag
    End If
End Sub

Met deze code kan drag en drop ingesteld worden voor elke listbox op een formulier, waarbij een lijst-item verplaatst wordt en wordt toegevoegd aan de onderzijde van de 'drop'-lijst.

Om dit werkend te krijgen op een formulier moet aan de bovenzijde van het codescherm van het formulier een variabele worden toegevoegd:

Private oDragDropForm As clDragDropForm

Daarna moeten de volgende 5 coderegels toegevoegd worden aan de UserForm_Initialize-gebeurtenis:

Private Sub UserForm_Initialize()
    Set oDragDropForm = New clDragDropForm
    With oDragDropForm
        Set .DragDropForm = Me
        .GetListboxes
    End With
End Sub

Tenslotte moet er de volgende coderegel toegevoegd worden aan de UserForm_QueryClose-gebeurtenis:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    oDragDropForm.TerminateDragDrop
End Sub

Deze laatste regel is van belang en mag absoluut niet weggelaten worden. Met deze regel worden namelijk alle aangemaakte objecten weer opgeruimd. De zogenaamde 'garbage collector' van VBA kan deze objecten niet automatisch opruimen als het formulier afgesloten wordt, omdat deze objecten onderling met elkaar verbonden zijn. Als deze coderegel wordt weggelaten blijven de objecten achter in het geheugen en ontstaat een zogenaamd 'geheugenlek' (memory leak).

Download een voorbeeldbestand van de basis versie:
zip-5Instellen van listbox drag en drop basis 1.0

Geavanceerde uitwerking

De drag en drop uit voorgaande paragraaf werkt op zich, maar is behoorlijk basaal en kan verder niet geconfigureerd worden. Er is daarom een geavanceerde versie ontwikkeld waarbij de drag en drop per formulier nauwkeurig kan worden geconfigureerd. Deze versie werkt ook met listboxen met meerdere kolommen en met mulitselect listboxen. De volgende parameters kunnen daarbij worden ingesteld:

  1. Drop effect: bepalen of het lijst item gekopieerd (CopyItem) of verplaatst (MoveItem (default)) moet worden.
  2. Drop type: bepalen hoe het item moet toegevoegd worden. Dat kan zijn op alfabetische volgorde (Alphabetic), aan het einde van de lijst (BottomOfList (default)), invoegen op de plek van de muisaanwijzer (CursorPosition) of op numerieke volgorde (Numeric).
  3. Toestaan van drop in eigen lijst: Ja of Nee (default). Deze instelling heeft alleen effect als bij DropType voor CursorPostion is gekozen. Bij andere DropTypes is deze instelling niet logisch.

Daarnaast kan nog met optionele parameters aangegeven worden dat de drag en drop alleen mag plaats vinden tussen listboxen met dezelfde groepsnaam. Stel een formulier bevat 4 listboxen en er mag alleen maar onderlinge drag en drop plaats vinden tussen listbox1 en 2 en er mag alleen maar onderlinge drag en drop plaatsvinden tussen listboxen 3 en 4. Dit kan dan als volgt ingesteld worden:

.GetListboxes ListBox3.Name & "~grp2", ListBox4.Name & "~grp2"

De groepsnaam moet dus toegevoegd worden aan de listbox naam gescheiden door een tilde(~). Omdat de default groepsnaam een lege string is, hoeft in dit geval maar 1 groepsnaam opgegeven te worden. Ook voor listbox1 en listbox2 mag wel een andere groepsnaam opgegeven worden, maar dat is in dit geval niet persé nodig. In plaats van ListBox3.Name & "~grp2" kan ook "ListBox3~grp2" als parameter meegegeven worden. Het gebruik van ListBox3.Name heeft als voordeel, dat er een foutmelding optreedt wanneer de naam van de ListBox3 wordt gewijzigd. Door die foutmelding wordt je erop geattendeerd dat dan ook ListBox3.Name aangepast moet worden. De kans op fouten in de configuratie wordt daardoor kleiner.

Een moeilijkheid bij drag en drop is dat het in VBA niet eenvoudig is te bepalen boven welk lijst-item de muisaanwijzer zich bevindt. Bij de ListBox-gebeurtenissen wordt wel de Y-waarde van de muispositie meegegeven, maar dat kan niet 1 op 1 vertaald worden naar een lijst-item. Daarom is er een speciaal algoritme gemaakt om de hoogte van een lijst-item te bepalen. De rijhoogte kan alleen maar bepaald worden als alle zichtbare rijen van de Listbox gevuld zijn met lijst-items. Mocht dat niet zo zijn, dan worden tijdelijk extra rijen toegevoegd totdat alle zichtbare rijen gevuld zijn. Hiermee kan dan uiteindelijk bepaald worden boven welk lijst-item de muisaanwijzer zich bevindt.

Een andere moeilijkheid betreft het werken met multiselect listboxen. Als je bijvoorbeeld 3 waarden selecteert en vervolgens op een lijst-item klikt om deze 3 items te verplaatsen naar een andere listbox, dan wordt bij het klikken deze laatste waarde weer geDEselecteerd. Dat is voor de gebruiker erg verwarrend. Daarom wordt bij multiselect listboxen ook het item meegenomen waarop geklikt wordt. Bij multiselect listboxen is het droppen in de eigen lijst uitgeschakeld. Dit omdat dit erg onbetrouwbaar werkt. De kans is dan namelijk te groot dat ongewild een drag en drop actie wordt uitgevoerd, terwijl de gebruiker bezig is met het selecteren van items. Misschien dat deze optie bij een volgende versie wordt toegevoegd.

Om de configuratie te vereenvoudigen is er ook een interface klasse toegevoegd. Op die manier wordt er voor gezorgd dat, bij de configuratie van de drag en drop op een formulier, er alleen maar de eigenschappen en methodes te zien zien die voor de configuratie van belang zijn. De overige eigenschappen en methodes zijn dan niet beschikbaar als keuzemogelijkheid.

De code voor deze geavanceerde versie is behoorlijk uitgebreid en complex en is daarom niet hier opgenomen op deze pagina. De volledige code is te vinden in het voorbeeldbestand dat gedownload kan worden:

Download een voorbeeldbestand van de geavanceerde versie:
zip-7Instellen van listbox drag en drop geavanceerd 1.0

Drag en drop voor listboxen op een werkblad

Het is ook mogelijk om drag en drop in te stellen voor ActiveX listboxen die op een werkblad zijn geplaatst. De code moet daarvoor wel op een aantal plaatsen aangepast worden, maar het basisprincipe blijft gelijk. Hieronder kan een voorbeeldbestand gedownload worden waarin dat te zien is. Dit voorbeeld is gebaseerd op de eenvoudige drag drop basisopzet uit dit artikel.

Download een voorbeeldbestand met listboxen op een werkblad:
zip-17Instellen listbox drag en drop op werkblad 1.0
 

Vragen / suggesties

Hopelijk heeft dit artikel geholpen bij het instellen van listbox drag en drop op een VBA formulier. Als er verdere vragen over dit onderwerp zijn of suggesties voor verbetering, plaats dan een reactie hieronder.

arrow_up