Bonjour à tous,
Suite à un besoin particulier j'ai trouvé mon bonheur sur le site pour retrouver l'arborescence des mes fichiers. J'ai donc récupéré le code, j'en ai vu plusieurs, tous aussi bien les uns que les autres, mais comme j'aime pas utiliser sans comprendre est ce que quelqu'un pourrait m'expliquer le code suivant :
Dim ligne
Sub arborescenceRepertoire()
racine = ChoixDossier() ' ou un répertoire C:\xxx e.g.
If racine = "" Then Exit Sub
Range("A:Z").ClearContents
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
ligne = 3
Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, niveau) = dossier.Name
Cells(ligne, niveau).Font.ColorIndex = 0
ligne = ligne + 1
For Each f In dossier.Files
Cells(ligne, niveau + 1) = f.Name
Cells(ligne, niveau + 1).Font.ColorIndex = 3
ligne = ligne + 1
Next
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
End Sub
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Merci de votre compréhension.
Bonne journée à tous.
Jack
Suite à un besoin particulier j'ai trouvé mon bonheur sur le site pour retrouver l'arborescence des mes fichiers. J'ai donc récupéré le code, j'en ai vu plusieurs, tous aussi bien les uns que les autres, mais comme j'aime pas utiliser sans comprendre est ce que quelqu'un pourrait m'expliquer le code suivant :
Dim ligne
Sub arborescenceRepertoire()
racine = ChoixDossier() ' ou un répertoire C:\xxx e.g.
If racine = "" Then Exit Sub
Range("A:Z").ClearContents
Set fs = CreateObject("Scripting.FileSystemObject")
Set dossier_racine = fs.getfolder(racine)
ligne = 3
Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
Cells(ligne, niveau) = dossier.Name
Cells(ligne, niveau).Font.ColorIndex = 0
ligne = ligne + 1
For Each f In dossier.Files
Cells(ligne, niveau + 1) = f.Name
Cells(ligne, niveau + 1).Font.ColorIndex = 3
ligne = ligne + 1
Next
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
End Sub
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Merci de votre compréhension.
Bonne journée à tous.
Jack