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
| Sub Appel()
'On déclare les variables FL1 comme une feuille de calcul et Chemin comme Chaîne de caractères.
Dim FL1 As Worksheet, Chemin As String
Application.ScreenUpdating = False
' On attribue une valeur (une chaîne de caractères) à Chemin
Chemin = "C:\Documents and Settings\Lucci\Bureau\Pole"
'On attribue une valeur (nom d'une feuille) à FL1
Set FL1 = ThisWorkbook.Worksheets("FeuilleRecap")
'On appelle la fonction Ouvrir avec comme argument Chemin et FL1 (précédemment défini)
Ouvrir Chemin, FL1
Application.ScreenUpdating = True
End Sub
Sub Ouvrir(Chemin As String, FL1 As Worksheet)
'On déclare fs (On ne lui donne pas de type?), i un entier et NomFich une chaîne de caractères
Dim fs, i As Integer, NomFich As String
'Set indique que l'on a un objet. Application est cet objet, FileSearch une méthode (a priori elle va permettre de chercher un fichier)
Set fs = Application.FileSearch
With fs
'On utilise fs et on lui applique les méthodes .LookIn (regarder dans) et FileType (qui sélectionne une type de fichier)
.LookIn = Chemin
.FileType = 4 '1 tous les fichiers, 3 = Doc, 4 = xls,
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
'Ouverture et traitement des fichiers pour tout i jusqu'à i=nombre de fichiers
For i = 1 To .FoundFiles.Count
' Ouvre le fichier/classeur i
Workbooks.Open .FoundFiles(i)
'exécute les appels en fil d'attente
DoEvents
'On attribue à NomFich le nom du classeur courant (a l'indice i)
NomFich = ActiveWorkbook.Name
'on appelle la fonction Copie avec comme paramètre FL1 et NomFich (précédemment définis)
Copie NomFich, FL1
'le compteur passe au i suivant
Next i
Else
' Sinon erreur pas de fichier type 4 dans le chemin Chemin
MsgBox "Aucun fichier n'a été trouvé."
End If
'Fin de la boucle With
End With
'Dès qu'on a terminé la boucle et que l'indice i=nombre de fichiers fs est vide
Set fs = Nothing
End Sub
Sub Copie(NomFich As String)
'Pour chaque LaFuille dans le classeur courant (nomfich étant le nom du Worbook actif)
For Each LaFeuille In Workbooks(NomFich).Worksheets
'pour copier le contenu de chaque feuille à la suite
'pas trouvé la signification de derlig, je ne voudrais pas dire n'imp
derlig = FL1.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copier LaFeuille après
LaFeuille.Copy After:=FL1.Sheets(FL1.Sheets.Count)
'Copier les colonnes utilisées de la feuille active
ActiveSheet.UsedRange.Copy
'Coller/valeurs dans la feuille active en A1
ActiveSheet.Range("A1").PasteSpecial Paste:=xlValues
'exécute les appels en fil d'attente
DoEvents
Next
End Sub |
Partager