Modif code arborescence fichier

Option Explicit

Dim Nb As Long
Const MaxNiv = 3

Sub arborescenceRepertoire()
Dim Racine As String
Dim FS As Object, dossier_racine As Object

    Racine = ChoixDossier()
    If Racine = "" Then Exit Sub
    Range("A:A").Clear
    Range("A3").Select
    Set FS = CreateObject("Scripting.FileSystemObject")
    Set dossier_racine = FS.getfolder(Racine)

    Application.ScreenUpdating = False
    Lit_dossier dossier_racine, 1
    Application.ScreenUpdating = True

    Set dossier_racine = Nothing
    Set FS = Nothing
    
    Range("A1").Select
End Sub

Private Function ChoixDossier()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
            Nb = 0
            ChoixDossier = .SelectedItems(1)
        End If
    End With
End Function

Private Sub Lit_dossier(ByRef dossier, ByVal niveau)
Dim d As Object

    Nb = Nb + 1
    ActiveCell.Value = String(3 * niveau - 1, " ") & dossier.Name
    Select Case niveau
        Case 1
            With ActiveCell
                .Font.Bold = True
                .Font.ColorIndex = 9
            End With
        Case 2
            With ActiveCell
                .Font.Bold = False
                .Font.ColorIndex = 45
            End With
        Case 3
            With ActiveCell
                .Font.Bold = False
                .Font.ColorIndex = 41
            End With
        Case 4
            With ActiveCell
                .Font.Bold = False
                .Font.ColorIndex = 50
            End With
            '   ..... etc
    End Select

    ActiveCell.Offset(1, 0).Select
    Application.StatusBar = Nb
    
    For Each d In dossier.SubFolders
        If niveau <= MaxNiv Then Lit_dossier d, niveau + 1
    Next d
    
    Set d = Nothing
End Sub