[RESOLU] Boucle While dans une macro

[wisefun77]

Bonjour,
J'ai cette macro de liste de fichier qui fonctionne bien.
Mais comment faire pour pour que la boucle While affiche les 10 premiers résultats dans la colonne A et les 10 autres dans la colonne B et ainsi de suite.
Et si le fichiers existe déjà ne pas le lister.

Code : Tout sélectionner

Sub TestListeFichiers()
    Dim Dossier As String
 
    'Définit le répertoire pour débuter la recherche de fichiers.
   '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
   'fichiers, sinon le temps de traitement va être très long).
   Dossier = "P:\Donnees\MemoExcel\MemoExcelTuto"
 
    'Appelle la procédure de recherche des fichiers
   ListeFichiers Dossier
 
    'Ajuste la largeur des colonnes A:E en fonction du contenu des cellules.
   Columns("A:E").AutoFit
    MsgBox "Terminé"
End Sub
 
 
 
Sub ListeFichiers(Repertoire As String)
    '
   'Nécessite d'activer la référence "Microsoft Scripting RunTime"
       'Dans l'éditeur de macros (Alt+F11):
       'Menu Outils
       'Références
       'Cochez la ligne "Microsoft Scripting RunTime".
       'Cliquez sur le bouton OK pour valider.

    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Récupère le numéro de la dernière ligne vide dans la colonne A.
   i = Range("A65536").End(xlUp).Row + 1
 
    'Boucle sur tous les fichiers du répertoire
   For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
       Cells(i, 1) = FileItem.Name
        'Ajoute un lien hypertexte vers le fichier
       ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
        'Indique la date de création
       'Cells(i, 2) = FileItem.DateCreated
       'Indique la date de dernier acces
       'Cells(i, 3) = FileItem.DateLastAccessed
       'Indique la date de dernière modification
       'Cells(i, 4) = FileItem.DateLastModified
       'Nom du répertoire
       'Cells(i, 5) = FileItem.ParentFolder

        i = i + 1
    Next FileItem
 
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
   For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

Voici le fichier

ListerFichierWhile.zip

Merci

[Kassy]

Bonjour Wisefun77,

Le file date un peu mais je vais tout de même t'apporter une réponse.

Je n'ai gardé que la procédure ListeFichiers et lui est enlevé tous les commentaires, car les modifications (en rouge) sont dans cette partie de code.

--------------------------------------------------------------------------
Sub ListeFichiers(Repertoire As String)

Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim i As Long
Dim j As Long

Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)

j = 1
i =Columns(j).End(xlUp).Row + 1

For Each FileItem In SourceFolder.Files
Cells(i, j) = FileItem.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, j]), _
Address:=FileItem.ParentFolder & "\" & FileItem.Name

If i = 11 Then
i = Columns(j).End(xlUp).Row + 1
j = j + 1
Else
i = i + 1
End If

Next FileItem

End Sub
----------------------------------------------------------------------------


J'espère que ma réponse te satisfait.

[wisefun77]

Bonjour Kassy,

Je vais tester .
Merci pour ta réponse.
Je suis sur que c'est ce que je cherche