Menu déroulant (ou vertical/horizontal) en fonction de la structure d'un répertoire

 listefichiers dossier.Path
  Me.ListBox2.Height = (n * 15)

Private Sub UserForm_Initialize()
  racine = "c:\"
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier = fs.GetFolder(racine)
  Me.ListBox1.Clear
  Me.ListBox2.Clear
  Me.ListBox3.Clear
  Me.ListBox4.Clear
  Me.ListBox5.Clear
  Me.ListBox6.Clear
  n = 0
  For Each d In dossier.SubFolders
       Me.ListBox1.AddItem d.Name
       Me.ListBox1.List(n, 1) = dossier.Path
       n = n + 1
   Next
   Me.TextBox1 = dossier.Path
   listefichiers dossier.Path
End Sub

Private Sub b_debut_Click()
  racine = ChoixDossier()     ' ou un répertoire C:\xxx e.g.
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier = fs.GetFolder(racine)
  Me.ListBox1.Clear
  Me.ListBox2.Clear
  Me.ListBox3.Clear
  Me.ListBox4.Clear
  Me.ListBox5.Clear
  Me.ListBox6.Clear
  n = 0
  For Each d In dossier.SubFolders
       Me.ListBox1.AddItem d.Name
       Me.ListBox1.List(n, 1) = dossier.Path
       n = n + 1
   Next
   Me.TextBox1 = dossier.Path
   listefichiers dossier.Path
End Sub

Private Sub ListBox1_Click()
  rép = Me.ListBox1.Column(1) & "\" & Me.ListBox1
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier = fs.GetFolder(rép)
  Me.ListBox2.Clear
  Me.ListBox3.Clear
  Me.ListBox4.Clear
  Me.ListBox5.Clear
  Me.ListBox6.Clear
  n = 0
  On Error Resume Next
  For Each d In dossier.SubFolders
    Me.ListBox2.AddItem d.Name
    Me.ListBox2.List(n, 1) = dossier.Path
    n = n + 1
  Next
  Me.TextBox1 = dossier.Path
  listefichiers dossier.Path
End Sub

Private Sub ListBox2_Click()
  rép = Me.ListBox2.Column(1) & "\" & Me.ListBox2
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier = fs.GetFolder(rép)
  Me.ListBox3.Clear
  Me.ListBox4.Clear
  Me.ListBox5.Clear
  Me.ListBox6.Clear
  n = 0
  For Each d In dossier.SubFolders
       Me.ListBox3.AddItem d.Name
       Me.ListBox3.List(n, 1) = dossier.Path
       n = n + 1
  Next
  Me.TextBox1 = dossier.Path
  listefichiers dossier.Path
End Sub


Private Sub ListBox6_Click()
  rép = Me.ListBox6.Column(1) & "\" & Me.ListBox6
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier = fs.GetFolder(rép)
  Me.TextBox1 = dossier.Path
  listefichiers dossier.Path
End Sub

Sub listefichiers(rép)
      Me.ListBox10.Clear
      nf = Dir(rép & "\*.*")
      n = 0
      Do While nf <> ""
        Me.ListBox10.AddItem nf
        Me.ListBox10.List(n, 1) = rép
        n = n + 1
        nf = Dir
      Loop
      For i = 1 To 6
        If Me("listbox" & i).ListCount = 0 Then
          Me("listbox" & i).Visible = False
        Else
          Me("listbox" & i).Visible = True
          Position = Me("listbox" & i).Left + Me("listbox" & i).Width
        End If
      Next i
      Me.ListBox10.Left = Position + 20
      Me.TextBox2.Left = Position + 20
      Me.TextBox2.Width = Me.ListBox10.Width
      Me.TextBox2 = n & " fichiers"
      Me.TextBox1.Width = Position - 65
      Me.ListBox10.Visible = (Me.ListBox10.ListCount > 0)
      Me.TextBox2.Visible = (Me.ListBox10.ListCount > 0)
      Me.Width = Position + IIf(Me.ListBox10.Visible, Me.ListBox10.Width, 0) + 40
End Sub

Private Sub ListBox10_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  ThisWorkbook.FollowHyperlink Me.ListBox10.Column(1) & "\" & Me.ListBox10
End Sub

Private Sub ListBox10_Click()
   Me.TextBox1 = Me.ListBox10.Column(1) & "\" & Me.ListBox10
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