Liste de fichiers dans Excel

Sub ListerFichierJPEG()  

Dim Repertoire As String, Fichier As String  
Dim Ws As Worksheet  
Dim i As Integer  
   
Application.ScreenUpdating = False  
   
'Définit la Première feuille du classeur contenant cette macro  
'(pour recevoir les donnée extraites du répertoire).  
Set Ws = ThisWorkbook.Worksheets(1)  
   
'Définit le répertoire de recherche  
Repertoire = ChoixRepertoire & "\"  
'Spécifie la recherche pour le fichiers .jpeg  
Fichier = Dir(Repertoire & "*.jpeg")  
 i = 1  
'Boucle sur les fichiers du répertoire  
Do While Fichier <> ""  
            i = i + 1  
        'Récupère le nom des fichiers jpeg sans l'extension  
         Pos = InStr(1, Fichier, ".", 1)  
         Ws.Cells(i, 5) = Left(Fichier, Pos - 1)  
           
         Fichier = Dir  
Loop  
   
Application.ScreenUpdating = True  
MsgBox "Terminé"  
End Sub  


Function ChoixRepertoire()  
   Dim objShell As Object, objFolder As Object, oFolderItem As Object  
    Dim Chemin As String  
      
    Set objShell = CreateObject("Shell.Application")  
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)  
      
    On Error Resume Next  
    Set oFolderItem = objFolder.Items.Item  
    Chemin = oFolderItem.Path  
    ChoixRepertoire = Chemin  
End Function