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
| Sub BtnListerFichiers_Click()
'Déclaration des variables
'Declare a variable as a FileDialog object.
Dim ApplSelectionDossier As FileDialog
'Create a FileDialog object as a File Picker dialog box.
'Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set ApplSelectionDossier = Application.FileDialog(msoFileDialogFolderPicker)
'créé un objet de système de fichier (je sais pas trop quoi ...)
Set fs = CreateObject("Scripting.FileSystemObject")
'Declare a variable to contain the path of each selected item. Even though the path is aString,
'the variable must be a Variant because For Each...Next routines only work with Variants and Objects.
Dim ListeItemChoisis As Variant
'nettoie le classeur
NettoyerLaFeuille (4)
'Use a With...End With block to reference the FileDialog object.
With ApplSelectionDossier
.Title = "Sélectionnez un dossier"
'vue de départ
'
'l'utilisateur a cliqué sur le bouton OK de la boite de dialogue
If .Show = -1 Then
Range("Nom").Offset(-1, 0) = "Liste fichiers présents dans le dossier :" & Chr(10) & .SelectedItems(1)
Range("Nom").Offset(1, 0).Activate
'pour chaque dossier choisi, ici un seul mais plus _
instruction plus facile à utiliser
For Each f2 In .SelectedItems
Call EcritureDonnées(fs.GetFolder(f2), 1)
Next
'The user pressed Cancel.
Else
End If
End With
ActiveSheet.Outline.ShowLevels RowLevels:=1
Range("Nom").Offset(1, 0).Activate
'Set the object variable to Nothing.
Set fd = Nothing
End Sub
Sub NettoyerLaFeuille(ByVal LigneDeDépart As Integer)
Rows(LigneDeDépart).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete
Selection.ClearOutline
Range("Nom").Offset(-1, 0) = "Liste fichiers présents dans le dossier :"
End Sub
Sub EcritureDonnées(ByVal f As Variant, ByRef niveau As Integer)
Dim DossierEnfantPrésent, FichiersPrésent As Boolean
PremièreLigne = ActiveCell.Row
'on récupère les dossiers enfants
Set fc = f.SubFolders
DossierEnfantPrésent = False
For Each f1 In fc
ActiveCell = f1.Name
On Error GoTo SuiteBoucle1
ActiveCell.Offset(0, 1) = f1.Type
ActiveCell.Offset(0, 2) = f1.Size / 1024 'taille en Ko
If ActiveCell.Offset(0, 2) > 1000 Then ActiveCell.Offset(0, 2).NumberFormat = "0.00,"" Mo"""
If ActiveCell.Offset(0, 2) > 1000000 Then ActiveCell.Offset(0, 2).NumberFormat = "0.00,,"" Go"""
SuiteBoucle1:
ActiveCell.Offset(1, 0).Activate
DossierEnfantPrésent = True
Call EcritureDonnées(fs.GetFolder(f1), niveau + 1)
Next
'on récupère ensuite les fichiers
Set fc = f.Files
FichiersPrésent = False
For Each f1 In fc
If FunctionNePasPrendreEnCompte(f1.Type) = True Then
Else
ActiveCell = f1.Name
On Error GoTo SuiteBoucle2
ActiveCell.Offset(0, 1) = f1.Type
ActiveCell.Offset(0, 2) = f1.Size / 1024 'taille en Ko
If ActiveCell.Offset(0, 2) > 1000 Then ActiveCell.Offset(0, 2).NumberFormat = "0.00,"" Mo"""
If ActiveCell.Offset(0, 2) > 1000000 Then ActiveCell.Offset(0, 2).NumberFormat = "0.00,,"" Go"""
SuiteBoucle2:
ActiveCell.Offset(1, 0).Activate
FichiersPrésent = True
End If
Next
'on groupe les lignes selon les cas
If niveau <> 1 Then
If DossierEnfantPrésent = True And FichiersPrésent = True Then _
Range(Rows(PremièreLigne), Rows(ActiveCell.Row - 1)).Group
If DossierEnfantPrésent = True And FichiersPrésent = False Then _
Range(Rows(PremièreLigne), Rows(ActiveCell.Row - 1)).Group
If DossierEnfantPrésent = False And FichiersPrésent = True Then _
Range(Rows(PremièreLigne), Rows(ActiveCell.Row - 1)).Group
'If DossierEnfantPrésent = False And FichiersPrésent = False Then _
Range(Rows(PremièreLigne), Rows(ActiveCell.Row - 1)).Group
'If DossierVide = False Then Range(Rows(PremièreLigne), Rows(ActiveCell.Row - 1)).Group
'If PremièreLigne = ActiveCell.Row - 1 And DossierVide = True Then Rows(PremièreLigne).Group
End If
'mise en forme des cellules
Columns("A:D").EntireColumn.AutoFit
End Sub |
