XL 2019 Listing fichiers dans dossier

Julien_m

XLDnaute Junior
Bonjour à tous,

j'ai trouvé sur internet un code vba (https://excel.developpez.com/faq/?page=FichiersDir) qui permet presque de faire ce que je veux.
Au départ il liste verticalement l'ensemble des fichiers dans un dossier.
J'ai modifié ça en le faisant lister horizontalement mais j'aimerais qu'il s'arrête après 2 fichiers par exemple et qu'il ne déborde pas sur les colonnes plus loin.
Une fois qu'il m'a listé les 2 fichiers du premier chemin en ligne 1, qu'il passe à la ligne 2 avec un nouveau chemin d'accès.

J'ai essayé de changer ça en boucle for mais je n'arrive pas à convertir la boucle loop en boucle for... 😕

Si quelqu'un peut m'éclaircir sur ce point je suis preneur :)

à bientôt,

Ju
 

Pièces jointes

  • Liste des fichiers dans dossier.xlsm
    14.9 KB · Affichages: 17
Solution
Il manquait le test If r <> "" Then :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                If Trim(CStr(r)) <> "" Then
                    fichier = Dir(CStr(r))
                    With Intersect(.Columns(col2(i)), r.EntireRow)
                        .ClearContents 'RAZ
                        n = 0
                        While fichier <> "" And n < .Count...

job75

XLDnaute Barbatruc
Bonjour Julien_m,

Les bonnes macros :
VB:
Sub Horizontal()
Dim Dossier As String, Fichier As String, i As Integer
Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
Fichier = Dir(Dossier & "*.xls*")
i = 1
Do While Fichier <> "" And i < 3
    i = i + 1
    Sheets("Feuil1").Cells(1, i) = Fichier
    Fichier = Dir
Loop
End Sub
VB:
Sub Horizontal2()
Dim Dossier As String, Fichier As String, i As Integer
Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
Fichier = Dir(Dossier & "*.xls*")
For i = 2 To 3
    If Fichier = "" Then Exit For
    Sheets("Feuil1").Cells(1, i) = Fichier
    Fichier = Dir
Next
End Sub
Edit : si l'on veut tous les types de fichiers remplacer "*.xls*" par "*.*"

A+
 
Dernière édition:

Rouge

XLDnaute Impliqué
Bonjour,

Autre proposition
VB:
Sub Horizontal2()
    Dim Dossier As String, Fichier As String, Lig As Integer, col As Integer
    Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
    Fichier = Dir(Dossier)
    col = 1
    Lig = 1
    Do While Fichier <> ""
        If Fichier <> "" Then
            Sheets("Feuil1").Cells(Lig, col) = Fichier
            If col = 2 Then
                col = 1
                Lig = Lig + 1
            Else
                col = col + 1
            End If
            Fichier = Dir
        End If
    Loop
End Sub

Cdlt
 

job75

XLDnaute Barbatruc
Bonjour Rouge,

Pour lister tous les fichiers dans les 2 colonnes B:C ceci est simple :
VB:
Sub Horizontal()
Dim Dossier As String, Fichier As String, n As Integer
Dossier = "C:\Users\julie\OneDrive - NGE\AUTRE\"
Fichier = Dir(Dossier)
With Sheets("Feuil1").[B:C]
    While Fichier <> ""
        n = n + 1
        .Cells(n) = Fichier
        Fichier = Dir
    Wend
    .Rows(Application.Ceiling(n / 2, 1) + 1 & ":" & .Rows.Count).ClearContents 'RAZ en dessous
End With
End Sub
A+
 

Julien_m

XLDnaute Junior
Merci à vous deux pour vos réponses.

J'ai essayé ce que tu m'as proposé job75, ça marche nickel.

Par contre (😅), j'essaie maintenant d'en assembler plusieurs dans une seule macro et ça me dit qu'il y a une erreur au deuxième Fichier=Dir....

VB:
Sub Horizontal()

Dim Dossier As String, Fichier As String, i As Integer, derlig As Integer

    derlig = Sheets("Feuil1").Range("Nombre_ligne_max") + 6

'Zone 1

    For j = 7 To derlig

        Dossier = Cells(j, 15)

        Fichier = Dir(Dossier)

        i = 16

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

    Next


'Zone 2

    For j = 7 To derlig

        Dossier = Cells(j, 21)

        Fichier = Dir(Dossier)

        i = 22

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

    Next

'Zone 3

    For j = 7 To derlig

        Dossier = Cells(j, 27)

        Fichier = Dir(Dossier)

        For i = 28 To 29

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

        Next

    Next

'Zone 4

    For j = 7 To derlig

        Dossier = Cells(j, 42)

        Fichier = Dir(Dossier)

        For i = 43 To 47

            If Fichier = "" Then Exit For

            Sheets("Feuil1").Cells(j, i) = Fichier

            Fichier = Dir

        Next

    Next

End Sub

Pour expliquer :
Chemin dossier 1 : colonne P (colonne n°15)
résultats en : Q (16)
Chemin dossier 2 : colonne V (21)
résultats en : W (22)
Chemin dossier 3 : colonne AB (27)
résultats en : AC & AD (28 & 29)
Chemin dossier 4 : colonne AQ (42)
résultats en : AR à AV (43 à 47)

le deuxième Fichier=Dir ne peut pas écraser le résultat du premier ?

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
D'après ce que je comprends :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                fichier = Dir(r)
                With Intersect(.Columns(col2(i)), r.EntireRow)
                    .ClearContents 'RAZ
                    n = 0
                    While fichier <> "" And n < .Count
                        n = n + 1
                        .Cells(n) = fichier
                        fichier = Dir
                    Wend
                End With
            Next
        End If
    Next
End With
End Sub
 

Julien_m

XLDnaute Junior
D'après ce que je comprends :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                fichier = Dir(r)
                With Intersect(.Columns(col2(i)), r.EntireRow)
                    .ClearContents 'RAZ
                    n = 0
                    While fichier <> "" And n < .Count
                        n = n + 1
                        .Cells(n) = fichier
                        fichier = Dir
                    Wend
                End With
            Next
        End If
    Next
End With
End Sub
erreur au premier fichier = Dir(r)
 

job75

XLDnaute Barbatruc
Il manquait le test If r <> "" Then :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                If Trim(CStr(r)) <> "" Then
                    fichier = Dir(CStr(r))
                    With Intersect(.Columns(col2(i)), r.EntireRow)
                        .ClearContents 'RAZ
                        n = 0
                        While fichier <> "" And n < .Count
                            n = n + 1
                            .Cells(n) = fichier
                            fichier = Dir
                        Wend
                    End With
                End If
            Next
        End If
    Next
End With
End Sub
 
Dernière édition:

Julien_m

XLDnaute Junior
Il manquait le test If r <> "" Then :
VB:
Sub ListesFichiers()
Dim col1, col2, i%, r As Range, fichier$, n%
col1 = Array("P", "V", "AB", "AQ") 'colonnes contenant les chemins des dossiers
col2 = Array("Q", "W", "AC:AD", "AR:AV") 'colonnes des résultats
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = 0 To UBound(col1)
        Set r = Intersect(.Columns(col1(i)), .UsedRange)
        If Not r Is Nothing Then
            For Each r In r
                If r <> "" Then
                    fichier = Dir(r)
                    With Intersect(.Columns(col2(i)), r.EntireRow)
                        .ClearContents 'RAZ
                        n = 0
                        While fichier <> "" And n < .Count
                            n = n + 1
                            .Cells(n) = fichier
                            fichier = Dir
                        Wend
                    End With
                End If
            Next
        End If
    Next
End With
End Sub
idem au second Fichier = dir 😅
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 009
Membres
101 865
dernier inscrit
MLL