Bonjour,
J'ai réussit à mettre en place un code qui permet de lister tous les fichiers d'un répertoire et sous répertoire.
Ce que je cherche à faire et de pouvoir créer une liste déroulante dans une cellule avec pleins de N°OF, et cette liste déroulante va me permettre lors de mon choix d'un N°OF de filtrer tous les fichiers lister conteannt ce N°OF mais je 'ny arrive pas et je trouve pas grand chose sur internet !
Je suis débutant au vba je fais cela pour monter en compétence et préparer mon stage de fin d'année !
Merci pour votre aide et votre temps !
voici mon code
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
Option Explicit
 
Sub TestListeFichiers()
    Dim Dossier As String
    Dim Rep As String
    Dim Dossel 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 = "C:\Users\" & Environ("Username") & "\Alstom\DLC - Documents\MS\CND"
 'Rep = "C:\Users\" & Environ("Username") & "\Alstom\FR LCR Industriel - Documents\General"
 ActiveSheet.Range("D3") = Dossier
 'ActiveSheet.Range("D6") = Rep
    '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)
    'Nettoyage Historique
    'ActiveSheet.Range("A2:E10000").ClearContents
 
 
    '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
    'If UCase(Fso.GetExtensionName(FileItem.Name)) = "xls" Then
        '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, 2) = FileItem.ParentFolder
 
        i = i + 1
        'End If
 
    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
 
End Sub