Treeview Drag & Drop

**damsmut** · 27/07/2010, 17h10

Bonjour,

J'ai essayé de suivvre ce tuto pour faire un drag & drop mais cela ne fonctionne pas... j'ai un message d'erreur :

erreur d'exécution '438' - Propriété ou méthode non gérée par cet objet

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
Private Sub Form_Open(Cancel As Integer)

TreeView1.Nodes.Add , , "coucou1", "coucou1"
TreeView1.Nodes.Add , , "coucou2", "coucou2"

TreeView1.Nodes.Add "coucou1", tvwChild, "hello1", "hello1"
TreeView1.Nodes.Add "coucou1", tvwChild, "hello2", "hello2"

TreeView1.Nodes.Add "coucou2", tvwChild, "hello4", "hello4"
TreeView1.Nodes.Add "coucou2", tvwChild, "hello5", "hello5"

End Sub

Private Sub TreeView1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)

    If Button = vbLeftButton Then
    
        boFlagEC = True
        
        'erreur ici
        TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
        'erreur ici
        TreeView1.Drag vbBeginDrag

    End If

End Sub

à l'aide please

merci
a+
Dams'

**tototiti2008** · 27/07/2010, 18h28

Bonjour damsmut,

j'ai fait un truc avec des drag & drop dans un treeview, mais ça n'a pas l'air d'intéresser grand monde
Le code est disponible, jette un oeil si tu veux :

http://www.developpez.net/forums/d91...ion-codes-vba/

mais de mémoire j'ai sué...

**damsmut** · 28/07/2010, 11h28

Salut tototiti2008,

c'est cool j'ai une piste déjà... par contre j'ai l'impression qu'il y'a pas mal de bugs dans les drags & drop dans ton programme.

Dès fois il ne veut pas déplacer des codes ou des groupes.

Et peux tu m'expliquer le principe d'un drag & drop ?

J'ai vu que tu as des actions sur "NodeClick" et "mousemove"... "mousemove" permettant de définir les coordonnées x,y des nodes à déplacer je pense...

mais par contre comment est-ce que tu gères un déplacement exactement au niveau des nodes du treeview ?
Là je bloque.

**tototiti2008** · 28/07/2010, 15h06

Bonjour damsmut,

par contre j'ai l'impression qu'il y'a pas mal de bugs dans les drags & drop dans ton programme.

Dès fois il ne veut pas déplacer des codes ou des groupes.

Pas de soucis chez moi.... si tu pouvais décrire le cas où ça ne marche pas

mais par contre comment est-ce que tu gères un déplacement exactement au niveau des nodes du treeview ?
Là je bloque.

Euh... qu'est-ce que tu appelles un déplacement exactement au niveau des nodes ?

**damsmut** · 28/07/2010, 16h46

par exemple je n'arrive pas à déplacer dans classes/g3 le fichier m5

le curseur ne change pas non plus si ge clic et que je déplace la souris

**tototiti2008** · 28/07/2010, 16h56

Re,

moi je déplace le fichier m5 dans un autre dossier ou une autre catégorie sans problèmes... comprend pas trop.
De même je le copie correctement à un autre endroit en maintenant Ctrl appuyé
Je suis en XL2003, et toi ?

**damsmut** · 28/07/2010, 18h14

xl2007

**damsmut** · 28/07/2010, 18h21

bon du coup en zieutant ton code et en fouinant sur le net j'ai écrit 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
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
Dim DragNode As Node
 
Private Sub Form_Open(Cancel As Integer)
 
    'Autorise le mode drag & drop
    TreeView1.OLEDragMode = 1
    TreeView1.OLEDropMode = 1
 
    'Création du Treeview1
    TreeView1.Nodes.Add , , "coucou1", "coucou1"
    TreeView1.Nodes.Add , , "coucou2", "coucou2"
    TreeView1.Nodes.Add , , "coucou3", "coucou3"
 
    TreeView1.Nodes.Add "coucou1", tvwChild, "hello1", "hello1"
    TreeView1.Nodes.Add "coucou1", tvwChild, "hello2", "hello2"
 
    TreeView1.Nodes.Add "coucou2", tvwChild, "hello4", "hello4"
    TreeView1.Nodes.Add "coucou2", tvwChild, "hello5", "hello5"
 
End Sub
 
Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
 
    'Si bouton gauche de la souris enfoncé
    If Button = 1 Then
        'Sur appuie de la souris, sélectionne le noeud cliqué comme noeud sélectionné
        Set TreeView1.SelectedItem = TreeView1.HitTest(x, y)
        Set DragNode = TreeView1.SelectedItem
        Texte5 = TreeView1.SelectedItem
    End If
End Sub
 
'Evenement glisser un noeud
Private Sub TreeView1_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
 
    'Glissement uniquement possible pour les noeuds enfants
    If Not DragNode Is Nothing Then
        'Met en surbrillance les noeuds survolés
        Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
    End If
 
End Sub
 
 
Private Sub TreeView1_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
 
    'Glissement uniquement possible pour les noeuds enfants
    If Not DragNode Is Nothing Then
        'Déposer = possible si il s'agit d'un noeud parent uniquement
        If TreeView1.HitTest(x, y).Parent Is Nothing Then
            Texte7 = TreeView1.DropHighlight.Text
            'Sélectionne le noeud de destination
            Set TreeView1.SelectedItem = TreeView1.DropHighlight
            'Réinitialise la surbrillance de déplacement
            Set TreeView1.DropHighlight = Nothing
        Else 'si noeud enfant --> impossible de déposer
            'Réinitialise la surbrillance de déplacement
            Set TreeView1.DropHighlight = Nothing
        End If
    End If
 
End Sub
 
Private Sub TreeView1_OLEStartDrag(Data As Object, AllowedEffects As Long)
 
    'Glissement uniquement possible pour les noeuds enfants
    If DragNode.Parent Is Nothing Then Set DragNode = Nothing
 
End Sub

Ça me permet dans un premier temps de gérer la réaction des highlights.
Par ailleurs je gère le fait de ne pouvoir déplacer un enfant que vers un autre parent.

Par contre comment faire maintenant pour réellement déplacer le nœud ?

**tototiti2008** · 28/07/2010, 18h39

Re,

Moi j'ai géré ça avec la Sub DeplCopNod (Module MPrincGestCode)

Il y a peut-être plus simple...

Edit : c'est marrant, on a pas vraiment les mêmes arguments pour les procédures évènementielles du Treeview
Par exemple, moi mes x et y pour le HitTest, je devais les multiplier par 15 (passage de twips en pixels, je crois)

Moi j'ai la référence "Microsoft Windows Common Controls 6.0 (SP6)" activée, tu en as une autre ?
Sur cette version du treeview, jamais réussi à faire fonctionner correctement l'évènement TreeView1_OLEDragDrop que tu as l'air d'utiliser sans soucis...

Bref quelques différences on dirait

**damsmut** · 29/07/2010, 09h36

il s'agit d'un treeview version 6.0

**damsmut** · 29/07/2010, 11h45

c'est bon j'ai trouvé... bien sûr c'est tout con...il suffit de changer le "parent" pour le node que l'on souhaite déplacer :

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
Dim DragNode As Node
 
Private Sub Form_Open(Cancel As Integer)
 
    'Autorise le mode drag & drop
    TreeView1.OLEDragMode = 1
    TreeView1.OLEDropMode = 1
 
    'Création du Treeview1
    TreeView1.Nodes.Add , , "coucou1", "coucou1"
    TreeView1.Nodes.Add , , "coucou2", "coucou2"
    TreeView1.Nodes.Add , , "coucou3", "coucou3"
 
    TreeView1.Nodes.Add "coucou1", tvwChild, "hello1", "hello1"
    TreeView1.Nodes.Add "coucou1", tvwChild, "hello2", "hello2"
 
    TreeView1.Nodes.Add "coucou2", tvwChild, "hello4", "hello4"
    TreeView1.Nodes.Add "coucou2", tvwChild, "hello5", "hello5"
 
End Sub
 
Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
 
    'Si bouton gauche de la souris enfoncé
    If Button = 1 Then
        'Sur appuie de la souris, sélectionne le noeud cliqué comme noeud sélectionné
        Set TreeView1.SelectedItem = TreeView1.HitTest(x, y)
        Set DragNode = TreeView1.SelectedItem
        Texte5 = TreeView1.SelectedItem
    End If
End Sub
 
'Evenement glisser un noeud
Private Sub TreeView1_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
 
    'Glissement uniquement possible pour les noeuds enfants
    If Not DragNode Is Nothing Then
        'Met en surbrillance les noeuds survolés
        Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
    End If
 
End Sub
 
 
Private Sub TreeView1_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
 
    'Glissement uniquement possible pour les noeuds enfants
    If Not DragNode Is Nothing Then
        'Déposer = possible si il s'agit d'un noeud parent uniquement
        If TreeView1.HitTest(x, y).Parent Is Nothing Then
            Texte7 = TreeView1.DropHighlight.Text
            'Sélectionne le noeud de destination
            Set TreeView1.SelectedItem = TreeView1.DropHighlight
            'Effectue le déplacement (=changement de parent)
            Set DragNode.Parent = TreeView1.SelectedItem
            'Réinitialise la surbrillance de déplacement
            Set TreeView1.DropHighlight = Nothing
            'Tri par ordre alphabétique
            DragNode.Parent.Sorted = True
        Else 'si noeud enfant --> impossible de déposer
            'Réinitialise la surbrillance de déplacement
            Set TreeView1.DropHighlight = Nothing
        End If
    End If
 
End Sub
 
Private Sub TreeView1_OLEStartDrag(Data As Object, AllowedEffects As Long)
 
    'Glissement uniquement possible pour les noeuds enfants
    If DragNode.Parent Is Nothing Then Set DragNode = Nothing
 
End Sub

**tototiti2008** · 29/07/2010, 12h38

Re,

désolé de ne pas avoir pu t'aider, si je colle ton code dans un Userform avec un Treeview1 dans mon XL2003, ça ne fonctionne pas...

Il y a bien des différences de gestion des Treeview entre XL2003 et XL2007

**damsmut** · 29/07/2010, 14h54

ici en plus je gère l'icône du pointeur de la souris

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Dim DragNode As Node
 
Private Sub Form_Open(Cancel As Integer)
 
    'Autorise le mode drag & drop
    TreeView1.OLEDragMode = 1
    TreeView1.OLEDropMode = 1
 
    'Affichage du treeview avec des lignes en pointillés et des +
    TreeView1.LineStyle = 1
 
    'Empêche la modification du texte des noeuds
    TreeView1.LabelEdit = 1
 
 
    'Création du Treeview1
    TreeView1.Nodes.Add , , "coucou1", "coucou1"
    TreeView1.Nodes.Add , , "coucou2", "coucou2"
    TreeView1.Nodes.Add , , "coucou3", "coucou3"
 
    TreeView1.Nodes.Add "coucou1", tvwChild, "hello1", "hello1"
    TreeView1.Nodes.Add "coucou1", tvwChild, "hello2", "hello2"
 
    TreeView1.Nodes.Add "coucou2", tvwChild, "hello4", "hello4"
    TreeView1.Nodes.Add "coucou2", tvwChild, "hello5", "hello5"
 
End Sub
 
Private Sub TreeView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Long, ByVal y As Long)
 
    'Si bouton gauche de la souris enfoncé
    If Button = 1 Then
        'Sur appuie de la souris, sélectionne le noeud cliqué comme noeud sélectionné
        Set TreeView1.SelectedItem = TreeView1.HitTest(x, y)
        Set DragNode = TreeView1.SelectedItem
        Texte5 = TreeView1.SelectedItem
    End If
End Sub
 
'Evenement glisser un noeud
Private Sub TreeView1_OLEDragOver(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
 
    With TreeView1
        'Glissement uniquement possible pour les noeuds enfants
        If Not DragNode Is Nothing Then
            'Met en surbrillance les noeuds survolés
            Set .DropHighlight = .HitTest(x, y)
 
            On Error Resume Next
            'Si essaie de déplacer un noeud dans un noeud enfant --> 'curseur d'interdiction
            If Not .HitTest(x, y).Parent Is Nothing Then
                Effect = vbDropEffectNone  'curseur d'interdiction
            End If
        Else
            'Si essai de déplacer un noeud parent --> curseur d'interdiction
            Effect = vbDropEffectNone 'curseur d'interdiction
        End If
    End With
 
 
End Sub
 
 
Private Sub TreeView1_OLEDragDrop(Data As Object, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
 
    'Glissement uniquement possible pour les noeuds enfants
    If Not DragNode Is Nothing Then
        'Déposer = possible si il s'agit d'un noeud parent uniquement
        If TreeView1.HitTest(x, y).Parent Is Nothing Then
 
            On Error Resume Next
            Texte7 = TreeView1.DropHighlight.Text
            'Sélectionne le noeud de destination
            Set TreeView1.SelectedItem = TreeView1.DropHighlight
            'Effectue le déplacement (=changement de parent)
            Set DragNode.Parent = TreeView1.SelectedItem
            'Réinitialise la surbrillance de déplacement
            Set TreeView1.DropHighlight = Nothing
            'Tri par ordre alphabétique
            DragNode.Parent.Sorted = True
        Else 'si noeud enfant --> impossible de déposer
            'Réinitialise la surbrillance de déplacement
            Set TreeView1.DropHighlight = Nothing
        End If
    End If
 
End Sub
 
Private Sub TreeView1_OLEStartDrag(Data As Object, AllowedEffects As Long)
 
    'Glissement uniquement possible pour les noeuds enfants
    If DragNode.Parent Is Nothing Then
        Set DragNode = Nothing
    End If
 
End Sub

Envoyé par tototiti2008

Re,

désolé de ne pas avoir pu t'aider, si je colle ton code dans un Userform avec un Treeview1 dans mon XL2003, ça ne fonctionne pas...

Il y a bien des différences de gestion des Treeview entre XL2003 et XL2007

Non c'est moi qui suis désolé... j'ai jonglé entre Excel et Access... et finalement la version que j'ai mis c'est pour Access

... effectivement sur Excel ça ne marche pas... je pensais que c'était pareil

1000 pardons.

**tototiti2008** · 29/07/2010, 16h11

Re,

j'ai jonglé entre Excel et Access

ça explique le Form_Open à la place du Userform_Initialize...

Et sur Excel tu arrives à faire fonctionner les procédures TreeView1_OLEDragOver et TreeView1_OLEDragDrop ? c'est juste par curiosité