IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Appliquer un Filtre à une liste de fichiers


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Futur Membre du Club
    Homme Profil pro
    Étudiant
    Inscrit en
    Mars 2020
    Messages
    2
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 28
    Localisation : France, Saône et Loire (Bourgogne)

    Informations professionnelles :
    Activité : Étudiant

    Informations forums :
    Inscription : Mars 2020
    Messages : 2
    Par défaut Appliquer un Filtre à une liste de fichiers
    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

  2. #2
    Expert confirmé
    Homme Profil pro
    retraité
    Inscrit en
    Juin 2012
    Messages
    3 444
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Juin 2012
    Messages : 3 444
    Par défaut
    Bonjour

    Que voulez-vous dire par N°OF ?

    Cordialement.

Discussions similaires

  1. Réponses: 2
    Dernier message: 03/07/2006, 21h14
  2. [VB]Récupérer une liste de fichiers
    Par yaya54 dans le forum VB 6 et antérieur
    Réponses: 3
    Dernier message: 20/02/2006, 17h03
  3. Appliquer un filtre depuis liste déroulante
    Par samlepiratepaddy dans le forum Access
    Réponses: 6
    Dernier message: 20/10/2005, 08h43
  4. Réponses: 3
    Dernier message: 08/10/2005, 01h02
  5. Réponses: 10
    Dernier message: 30/01/2005, 21h53

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo