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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
| Option Explicit
Dim mPath As String 'Valeur renvoyée par la function ShowExplore
Function ShowExplore(ByVal Path As String, ByVal Titre As String, Optional DefautPath As String = "") As String
'Initialise le Node avec le path
Dim x As Integer
Dim i As Integer
Dim M As String
Tree.Nodes.Clear 'Raz Tree
mPath = "" 'Raz Variable de retour
Caption = Titre 'Affiche le titre dans le caption
If Right$(Path, 1) = "\" Then
Path = Trim$(Mid$(Path, 1, Len(Path) - 1)) 'enleve éventuellement le \ au bout de path
End If
ExploreDir "", Path 'Explore les dossiers du chemin de départ
'Explore les branches pour chercher celles qui ont des sous dossiers
x = Tree.Nodes.Count '
For i = 1 To x
With Tree.Nodes.Item(i)
ExploreDir .Key, .Key
End With
Next i
IniDefautPath DefautPath
Show 1
ShowExplore = mPath
End Function
Private Sub ExploreDir(ByVal Fils As String, ByVal Path As String)
Dim M As String
Path = Path & "\"
On Error GoTo Sortie 'Sortir de la routine si la branche a déjà été Explorée
Screen.MousePointer = vbHourglass
Tree.Visible = False
DoEvents
'Initialise la commande dir
M = Dir(Path, vbDirectory Or vbHidden Or vbReadOnly Or vbSystem)
Do While Not M = ""
'Je n'ai pas trouvé d'autre moyen pour afficher tout les dossiers (cachés, systems, lecture seule) que
'd'exclure les nom comportant un point.
'Ce n'est pas parfait mais je n'arrive pas à afficher que les dossiers sans cela.
'A PAUFINER
If InStr(Path & M, ".") = 0 Then
If Fils = "" Then
Tree.Nodes.Add , , Path & M, M, 1 'Création des branches dont la mère et Root
Else
Tree.Nodes.Add Fils, tvwChild, Path & M, M, 1 'Création des branches dont la mère est connue
End If
End If
' Tree.Sorted = True
M = Dir 'pointe sur le dossier/fichier suivant
Loop
Sortie:
On Error GoTo 0
Screen.MousePointer = vbDefault
Tree.Visible = True
End Sub
Private Sub IniDefautPath(ByVal DefautPath As String)
'Cette sub permet de charger dans le treeView la branche
'contenant le dossier DefautPath lors de l'affichage de la feuille
Dim i As Integer
Dim M As String
Dim Key As String
Dim Tbl
M = DefautPath 'Transfet dans M le DefautPath
'EtqDir.Caption = "" 'Raz l'étiquette d'affichage
'Sortir si le defaut path n'existe pas sur le disque
If M = "" Or Dir(M, vbDirectory Or vbHidden Or vbSystem Or vbReadOnly) = "" Then Exit Sub
'EtqDir.Caption = M 'Affiche le chemin dan le label
'-----------------------------------------------------
'Boucle à l'envers sur les Nodes pour rechercher dans
'les clés la correspondance avec DefautPath
For i = Tree.Nodes.Count To 1 Step -1
With Tree.Nodes.Item(i)
If InStr(DefautPath, .Key) > 0 Then 'Key trouvée !
Key = .Key 'Sauvegarde dans de la Key
M = Mid$(DefautPath, Len(.Key) + 2) 'Prendre dans la Key l'éventuel reste du chemin
Exit For 'Sortir
End If
End With
Next i
'--- Ajout et sélection de la branche
M = M & "\" 'Ajoute un "\" au bout de m
Tbl = Split(M, "\") 'Split dans Tbl m
'Boucle sur les Items de Tbl pour ajouter chaque branche
For i = 0 To UBound(Tbl)
ExploreDir Key, Key 'Ajoute la branche
Key = Key & "\" & Tbl(i) 'Concaténation key pour la branche suivante
Next i
On Error Resume Next
Tree.Nodes.Item(DefautPath).Selected = True 'Selectionne la branche DefautPath
On Error GoTo 0
End Sub
Private Sub Form_Load()
Dim str_dossier_courant As String
str_dossier_courant = Form1.ShowExplore("C:\", "Essai de JosDir", App.Path)
End Sub
Private Sub Tree_Collapse(ByVal Node As MSComctlLib.Node)
Node.Image = 1
End Sub
Private Sub Tree_Expand(ByVal Node As MSComctlLib.Node)
mkBranche Node
Node.Image = 2
End Sub
Private Sub mkBranche(ByVal Node As MSComctlLib.Node)
'Cette sub est appelée lors du click sur un node
'Elle permet de créer les branches filles du node
'qui a été cliqué ainsi que toutes les branches suitantes
'Cela permet d'anticiper sans ralentissement trés important.
Dim LastFils As String 'Key du dernier noeud de la branche
On Error GoTo Sortie 'Sortir si la branche a déjà été traitée
ExploreDir Node.Key, Node.Key 'Explore cette branche
Set Node = Node.Child 'Connect au noeud suivant
LastFils = Node.LastSibling.Key 'Sauve la key du dernier noeud
'Boucle qui permet de traiter toutes les branches suivantes de la
'branche qui a été cliquée.
Do
ExploreDir Node.Key, Node.Key 'Explore le dossier
If Node.Key = LastFils Then Exit Do
Set Node = Node.Next 'Passe à la branche suivante
Loop 'fin de boucle
Sortie:
On Error GoTo 0
End Sub |
Dir *.doc dans un TreeView
Répondre avec citation
Envoyé par J-il252313
Partager