[VBA]Drag & Drop d'un fichier dans une listview

Bonjour,

Je souhaiterais savoir s'il est possible de faire un Drag & Drop d'un fichier (à partir d'un explorateur de fichier), et de le déposer dans mon composant listview, afin d'ajouter dans cette liste le nom du fichier déposé.

Merci

Bien sûr que c'est possible.

Voici un code que j'ai écris il y a quelques années (il fonctionne, mais je ne garantis pas qu'il soit hyper leché: je ne suis pas un pro de VBA:roll: ):

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
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Private Sub lvwDocuments_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim itemTarget As MSComctlLib.ListItem, itemSource As MSComctlLib.ListItem
    Dim docTarget As clsBrowseDoc, docSource As clsBrowseDoc
 
    Effect = 0
 
    ' Récupère l'objet sur le quel on fait le drop
    Set itemTarget = Me.lvwDocuments.HitTest(x, y)
    If (itemTarget Is Nothing) Then Exit Sub
 
    Set docTarget = collDocuments.Item(itemTarget.Tag)
 
    ' Récupération de l'objet droppé
    Dim srcTag As String
    If (Data.GetFormat(VbCfText)) Then
        On Error GoTo InvalidSource
        srcTag = Data.GetData(VbCfText)
        On Error GoTo 0
        Else
        GoTo InvalidSource
        End If
 
    ' On vérifie que la source provient bien de notre fenêtre
    Set docSource = GetDocument(itemSource)
    If itemSource.Tag <> srcTag Then GoTo InvalidSource
 
    ' Analyse des combinaisons autorisées
    ' -- inconnu sur connu: on va utiliser le connu comme base pour l'inconnu.
    If (docSource.DocType = -1) And (docTarget.DocType = 0) Then
        Dupliquer_Document docSource, docTarget
 
    ' -- DB seulement sur inconnu: on va changer le chemin du DB seulement pour le référencer l'icnonnu
    ElseIf (docSource.DocType = -2) And (docTarget.DocType = -1) Then
        docSource.doc.chemin = docTarget.doc.chemin
        docSource.doc.fichier = docTarget.doc.fichier
        CorrigerBase_Document docSource, itemSource
        Me.lvwDocuments.ListItems.Remove itemTarget.Index
 
    ' -- sinon erreur
    Else
        MsgBox "Vous ne pouvez pas dropper cet élément ici", vbExclamation, TitleBox
        Exit Sub
        End If
 
 
    Effect = 1
 
    Exit Sub
NoRow:
    Exit Sub
 
InvalidSource:
    MsgBox "Impossible de déterminer la source.", vbExclamation, TitleBox
    Exit Sub
 
End Sub
 
 
Private Sub lvwDocuments_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
    If (Effect <> 1) Then Exit Sub
 
    Dim it As MSComctlLib.ListItem
    If (y >= 0) And (y <= 50) Then
        Set it = Me.lvwDocuments.HitTest(x, y)
        If (Not (it Is Nothing)) Then
            If (it.Index > 1) Then Set it = Me.lvwDocuments.ListItems(it.Index - 1)
            If (it.Index >= 1) Then it.EnsureVisible
            End If
 
    ElseIf (y <= Me.lvwDocuments.Height) And (y >= Me.lvwDocuments.Height - 50) Then
        Set it = Me.lvwDocuments.HitTest(x, y)
        If (Not (it Is Nothing)) Then
            If (it.Index < Me.lvwDocuments.ListItems.Count) Then _
                    Set it = Me.lvwDocuments.ListItems(it.Index + 1)
            If (it.Index <= Me.lvwDocuments.ListItems.Count) Then _
                it.EnsureVisible
            End If
 
    Else
        Set it = Me.lvwDocuments.HitTest(x, y)
        End If
 
End Sub
 
Private Sub lvwDocuments_OLEStartDrag(Data As Object, AllowedEffects As Long)
 
    Data.Clear
 
    Dim currItem As MSComctlLib.ListItem
    Dim doc As clsBrowseDoc
    Set doc = GetDocument(currItem)
 
    If (doc.DocType >= 0) Then
        AllowedEffects = 0
        Exit Sub
        End If
 
    AllowedEffects = 1
 
    Data.SetData currItem.Tag, VbCfText
 
End Sub

Quelques infos:
- lvwDocuments: c'est ma listView,
- ce code permet de démarrer un drag&drop depuis la listView (OLEStartDrag) et réceptionner un élément droppé (OLEDragDrop)
- Pour ton cas, tu devrais au minimim mettre la propriété OLEDropMode de ta ListView à 1 (ccOLEDropModeManual).

Je te laisse jouer du F1 pour comprendre exactement la syntaxe des évennements liés au Drag&Drop dans VBA.

Merci,

Mais "clsBrowseDoc" c'est une classe que tu as créé ?
As-tu son code ?

Citation:

Mais "clsBrowseDoc" c'est une classe que tu as créé ?

Effectivement, mais dans cet exemple, elle ne sert qu'à savoir si le "type" de l'élement est un type que l'utilisateur peut dragger (ex le documents bleus peuvent être dragger, les rouges ne le peuvent pas).
Comme tu ne souhaites que déposer des éléments dans ta liste, ceci ne te concerne pas.

L'application à partir de laquelle tu va commencer ton drag&drop a ses propres règles pour autoriser le drag. Tu ne les maîtrises pas. Tu peux seuelement de ton côté vérifier le contenu de ce que l'utilisateur te droppe et voir si tu accepte ou pas. C'est l'intérêt de l'event Drag_Over: adapter l'icône pour dire à l'utilisateur: ici j'accepterai ton objet si tu le droppe, ici je ne l'accepterai pas.