Liste fichier et extraction informations

Gasp73 · 14 Août 2012

Bonjour à tous,

Voici mon problème : dans un fichier Excel "maître", je cherche à synthétiser des informations contenues dans d'autres fichiers Excel (tous au même format, puisqu'il s'agit de formulaires à remplir).
J'ai trouvé sur les forums une macro qui me permet de chercher tous les fichiers Excel contenus dans un certain dossier, et de copier sur mon fichier "maître" les informations "Windows" relatives à ces fichiers (date de création, lien hypertexte vers ce fichier etc). Jusque là tout va bien, puisque j'ai besoin de copier ces informations aussi...

Seulement, j'aimerais en plus récupérer des infos contenu dans les fichiers Excel en question (dans des cellules spécifiques des feuilles du fichier), et là j'ai un souci car la macro originale ne me permet pas de pouvoir ouvrir le fichier et de lire les infos dans les cellules (ou du moins j'ignore comment faire).

J'ai écumé les sujets sur le forum, sans trouver de réelles réponses à mon problèmes, et après de multiples tentatives de recopiage de code, je décide de demander votre aide !!

Voici le bout de code qui pose problème :

Code:

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
    If Genre = APA Then
        For Each fichier In SourceFolder.Files
            'Récupère que les fichiers Excel, créés sous le nouveau format d'APA (après le 01/08/2012)
            If FileItem.Name Like "?*.xls" And CDate(Format(FileItem.DateCreated, "dd/mm/yyyy")) > DateValue("01/08/2012") Then
            'Ajoute un lien hypertexte vers le fichier
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 7), _
            Address:=FileItem.ParentFolder & "\" & FileItem.Name
            'Indique la date de création du fichier
            Cells(i, 8) = FileItem.DateCreated

            FileItem.Open     'Cette ligne pose problème dans la macro, puisqu'il n'arrive pas à ouvrir le fichier...
            DateO = ActiveWorkbook.Sheets("formulaire").Range("D17").Text
            Intitule = ActiveWorkbook.Sheets("formulaire").Range("C6").Text
            Secteur = ActiveWorkbook.Sheets("formulaire").Range("D15").Text
            a = 0
            'Boucle pour compter les actions ouvertes
            For k = 45 To 48
                If Cells(k, 6) <> "" Then a = a + 1
                End If
            Next
            NbreO = a
            'Boucle pour compter les actions clôturées
            b = 0
            For L = 45 To 48
                If Cells(L, 15) <> "" Then b = b + 1
                End If
            Next
            NbreC = b
            DateC = ActiveWorkbook.Sheets("formulaire").Range("N19").Text
            
            'Inscrit la date de l'APA dans la 1ère cellule du fichier maître
            ThisWorkbook.Sheets("APA").Cells(i, 1) = DateO
            'Indique le libellé de l'APA (intitulé de la panne)dans la 2nde cellule
            ThisWorkbook.Sheets("APA").Cells(i, 2) = Intitule
            'Indique le secteur de l'APA
            ThisWorkbook.Sheets("APA").Cells(i, 3) = Secteur
            'Indique le nombre d'actions ouvertes
            ThisWorkbook.Sheets("APA").Cells(i, 4) = NbreO
            'Indique le nombre d'actions clôturées
            ThisWorkbook.Sheets("APA").Cells(i, 5) = NbreC
            'Indique la date de clôture
            ThisWorkbook.Sheets("APA").Cells(i, 6) = DateC

            i = i + 1
            End If
            FileItem.Close
        Next FileItem

.....

Je vous remercie d'avance car là je bloque vraiment !

Orodreth · 3 Septembre 2012

Re : Liste fichier et extraction informations

Bonjour,

Je viens tout juste de revenir sur ce forum parce que j'ai moi-même quelques recherches à faire.
Du coup, je suis tombé sur ton poste (et je m'étonne que personne ne t'ait encore répondu).

J'ai quelques bouts de code à la maison qui devrait pouvoir t'aider à résoudre ton problème.

Mais si déjà je peux te donner une piste, voilà mon conseil:
Il faut que tu références tes classeurs ouverts pour pouvoir bosser dessus à loisir.

Ca se traduit comme ça:

Code:

'Déclaration de la variable qui référence le classeur maître
Dim WB_Maitre as WorkBook
'Affectation de la variable du classeur maître
Set WB_Maitre = activeworkbook
/!\ Ici, "activeworkbook" n'est valable que si ton classeur maître est ton classeur qui a le focus.
Sinon, il faut que tu le retrouves avec une boucle for each WB as Workbook in Workbooks en testant sur son nom.
'Déclaration de la variable qui référence le classeur enfant en cours de lecture
Dim WB_Enfant as Workbook
'Affectation de la variable du classeur enfant
Set WB_Enfant = ...

Pour les classeurs enfants, tu les ouvres et tu les fermes un par un.
La variable enfant te permet de travailler sur le classeur que tu dois lire pour récupérer tes infos.
Si tu connais précisément la position de tes infos, tu n'as plus qu'à faire transiter les infos.

Je me pencherai ce soir un peu plus avant sur l'aspect ouverture/fermeture de classeur excel.

Cordialement,
Thomas

Liste fichier et extraction informations

Gasp73

XLDnaute Nouveau

Orodreth

XLDnaute Impliqué

Discussions similaires

Liste fichier et extraction informations

Gasp73

XLDnaute Nouveau

Orodreth

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency