Modifier macro

Bonjour,

j'ai récupéré cette macro qui fonctionne très bien mais qui en fait trop pour mon utilisation.

En effet, elle liste les fichiers d'un dossier et de ses sous-dossiers.

Seulement pour mon utilisation j'ai seulement besoin de lister les nom du dossier et non des sous dossiers.

Pouvez vous me la modifier svp ?

Merci d'avance

Bonsoir,

une proposition :

Sub Lit_dossier(ByRef dossier, ByVal niveau)
    Dim oFile
    Dim CheminDuFichier As String
    Application.ScreenUpdating = False
    Cells(ligne, 2) = String(3 * (niveau - 1), " ") & dossier.Name
    Cells(ligne, 2).Font.Bold = True
    ligne = ligne + 1
    For Each d In dossier.SubFolders
        If niveau + 1 < 3 Then
            Lit_dossier d, niveau + 1
            For Each oFile In d.Files
                Cells(ligne, 3).Value = oFile.Name
                CheminDuFichier = d & "\" & oFile.Name
                ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 3), Address:= _
                CheminDuFichier ', TextToDisplay:="bordereau DRH.doc"
                Cells(ligne, 3).EntireRow.Hidden = True
                ligne = ligne + 1
            Next oFile
        End If
    Next d
    Application.ScreenUpdating = True
    Columns(2).EntireColumn.AutoFit
End Sub

En fait le code ajoute 1 au niveau afin d'aller plus en profondeur... On limite cette profondeur à 2 avec "niveau+1 < 3"

Essayez et dites moi si cela vous convient...

@ bientôt

LouReeD

Bonjour,

Le code fonctionne parfaitement mais le problème c'est que je voudrais réutiliser les informations du résultat pour faire une liste de données. Cependant, il prend en compte les espaces des sous répertoires. Concrètement, lorsque je fais copier coller de la liste il y a des espaces blancs entre les résultats.

Etes-il possible de n'avoir uniquement que la ligne de dossier 1 et pas du tout de sous dossiers ?

merci

Bonjour,

après quelques essais "accessibles" à tout le monde ( ), voici le résultat :

Sub arborescenceRepertoire()
    Application.ScreenUpdating = False    racine = ChoixDossier()     ' ou un répertoire C:\xxx e.g.
    If racine = "" Then Exit Sub
    Range("A:E").ClearContents
    Range("A1:E60000").EntireRow.Hidden = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dossier_racine = fs.GetFolder(racine)
    ligne = 3
    Lit_dossier dossier_racine, 1
    Application.ScreenUpdating = True
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
    Dim oFile
    Dim CheminDuFichier As String
    Application.ScreenUpdating = False
    Cells(ligne, 2) = String(3 * (niveau - 1), " ") & dossier.Name
    Cells(ligne, 2).Font.Bold = True
    ligne = ligne + 1
    For Each d In dossier.SubFolders
        If niveau + 1 < 3 Then
            Lit_dossier d, niveau + 1
'            For Each oFile In d.Files
'                Cells(ligne, 3).Value = oFile.Name
'                CheminDuFichier = d & "\" & oFile.Name
'                ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 3), Address:= _
'                CheminDuFichier ', TextToDisplay:="bordereau DRH.doc"
'                Cells(ligne, 3).EntireRow.Hidden = True
'                ligne = ligne + 1
'            Next oFile
        End If
    Next d
    Application.ScreenUpdating = True
    Columns(2).EntireColumn.AutoFit
End Sub

La première partie ajout en surligné des Application.ScreenUpdating pour éviter à l'écran de "clignoter"

Ensuite mise en commentaire de la partie qui apparemment est faite pour extraire les fichiers des dossiers

et toujours le if niveau +1 <3 afin de s'arrêter à la liste des dossiers qui se trouve dans le dossier sélectionné au commencement de la procédure.

Résultat : la liste de ces dossier, sans lignes vides entre. Est-ce que c'est votre attente ?

@ bientôt

LouReeD

je suis vraiment désolé mais je n'arrive pas à faire fonctionner cette macro...

Pouvez vous la vérifier svp ?

Merci

Bonsoir,

ci joint le fichier avec le code modifié :

Le résultat de ce code est :

Sélection d'un dossier, le code s'exécute, il y a sur la feuille finale :

en première ligne le nom du dossier choisi en début de procédure, puis tous les sous dossiers contenu dans ce dossier, sans faire l'extraction des fichiers et/ou dossiers contenus éventuellement dans ces différents dossiers.

Ce qui manque, la liste des fichiers étant dans le dossier sélectionné en début de procédure.

@ bientôt

LouReeD