Dim F, fs, s, f1, f2, fc
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
End If
'mise en forme des cellules
Columns("A:D").EntireColumn.AutoFit
End Sub
