XL 2019 Ajouter quelques propriétés au code existant (liste répertoires et sous-répertoires)

[re4]

Bonjour,
le code que j'ai récupéré ici 'https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/page-2#posts fonctionne très bien et merci à l'auteur mais je voudrai ajouter à la colonne après le dernier niveau le poids du répertoire racine et des sous-répertoires.
J'ai bien tenté une petite modif mais je n'arrive qu'a afficher qu'a la colonne +1 (modif en '***)
Avec votre aide j'arriverai peut-être à afficher d'autres propriétés au besoin...
Bonne journée

'https://www.excel-downloads.com/threads/vba-liste-dossiers-et-sous-dossiers-dun-dosssier.126930/page-2#posts
Dim ligne
Sub arborescenceRepertoire()
  racine = ChoixDossier()     ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A:h").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
 
  ligne = 3
  Lit_dossier dossier_racine, 1

'*** Cells(3, 2) = fs.getfolder(racine).Size
 
  End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, niveau) = dossier.Name

'*** Cells(ligne, niveau + 1) = dossier.Size

   ligne = ligne + 1
     For Each d In dossier.SubFolders
      Lit_dossier d, niveau + 1
   '  MsgBox niveau
    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

 

[sylvanu]

Bonjour Re4,
En PJ un bricolage, j'ai rajouté la taille des répertoires en colonne I avec :

'-----------------------------------------------
    ' Ligne ajoutée
    Cells(ligne, "I") = fs.GetFolder(dossier).Size
'-----------------------------------------------

et modifié Lit_dossier pour transférer fs à la sub.

 

[re4]

Bonjour,
Merci beaucoup, ça fonctionne, est'il possible que le poids s'affiche juste après la colonne du dernier niveau ?
Il me semble qu'avec cette condition l'on ne sera pas limité par le nombre de sous-répertoires
Exemple :
pour 2 sous-repertoires affichage en colonne D (racine + sous-rep)
pour 3 sous-repertoires affichage en colonne E

 

[sylvanu]

Re,
Vous pouvez faire :

Cells(ligne, niveau + 2) = fs.GetFolder(dossier).Size

Mais ça me semblait beaucoup moins lisible.

 

[re4]

Merci sylvanu, j'ai du mal poser ma requête, je ne voudrait pas que cela s'affiche immédiatement
à droite mais que tout s'affiche à la dernière colonne non utilisée, dans l'exemple ci-dessous en colonne E pour 3 sous-répertoires, colonne F s'il y avait 4 sous rep.

Peut-être faut'il déterminer le nombre de niveau dès le départ ?

 

[sylvanu]

Désolé, mais avec cette structure je ne sais pas faire car lors du déroulement on n'a pas connaissance des dossiers qui vont suivre.
Peut être mettre en colonne Z, et à la fin supprimer les colonnes vides ?
Ou encore mettre en colonne A, guère orthodoxe mais plus simple à mettre en place.

 

[sylvanu]

Inesthétique mais qui marche en appliquant la première hypothèse. Voir PJ.

 

[re4]

ok merci, c'est ce que j'avais fait en attendant peut-être une solution plus esthétique

 

[sylvanu]

Avec un peu de persévérance. Je mémorise la dernière colonne utilisée dans une variable globale et supprime d'un coup toutes les colonne vide avec :

If niveau + 1 > GdNiveau Then GdNiveau = niveau + 1

    ' Suppression colonnes vides
    Application.ScreenUpdating = False
    Range(Cells(1, GdNiveau + 1), Cells(65500, 25)).Select
    Selection.Delete Shift:=xlToLeft
    [A1].Select
    Application.ScreenUpdating = True

Déjà plus esthétique.

 

[re4]

Ok merci beaucoup, je regarde ça plus tard mais nul doute que ça fonctionne bien ,-)