Boucle sur les fichiers d'un répertoire, comptage du nombre de fichiers et barre de progression

**ncl98** · 27/07/2020, 10h50

Bonjour le Forum,
J'ai rédigé un code avec une boucle sur tous les fichiers avec l'extension "xlsx" enregistrée dans un même répertoire pour une mise à jour mensuelle. Le code est lui-même logé dans un fichier distinct. Pour exécuter la barre de progression, j'ai besoin de connaitre le nombre de fichiers à traiter.
Le code fonctionne normalement mais en activant la fonction de comptage des fichiers, une erreur se produit à la ligne 94 (message d'erreur = "Argument ou appel de procédure incorrect").
Votre aide sera la bienvenue car je suis à court d'idée.
Merci par avance.

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Option Explicit
 
Sub ReportEncoursMensuels()
'------------------------------------------
'Déclaration des varialble de portée privée
'------------------------------------------
Dim n As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim i As Integer
Dim Col As Integer
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim NomSource As String
Dim NomCible As String
Dim RubriqueSource As String
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim Cible As Variant
Dim Col2 As Integer
Dim t As Long
Dim MoisReport As Integer
Dim AnnéeEncours As Integer
Dim TotalEncours As Long
Dim ColMois As Integer
Dim ColCible As Integer
Dim Chemin As String
Dim Fichier As String
Dim CompteurFichiers As Integer
Dim ProgressionEnCours As Double
Dim PourcentageProgression As Double
Dim LargeurBarre As Long
 
Application.ScreenUpdating = False
 
'-----------------
'Top Chrono départ
'-----------------
t = Timer
'-------------------------------------------------------------------------------------------
'Boucle sur tous les fichiers du répertoire de travail pour compléter les tableaux d'encours
'-------------------------------------------------------------------------------------------
Chemin = ThisWorkbook.Path & "\"                                                   'Définition du répertoire contenant les fichiers à traiter (Variable "Chemin")
Fichier = Dir(Chemin & "*.xlsx")                                                   'Sélection de chaque fichier "xlsx" du répertoire de travail (Variable "Fichier")
Do While Len(Fichier) > 0                                                          'Début de la boucle, tant qu'il existe un fichier avec l'extension "xlsx"
 Set wb1 = Workbooks.Open(Chemin & Fichier)                                        'Valorisation de la variable Classeur Excel "wb1" à mettre à jour
 CompteurFichiers = CompteurFichiers + 1                                           'Compteur nombre de fichiers traités
 Set wb2 = ThisWorkbook                                                            'Valorisation de la variable Classeur Excel "wb2" dans lequel s'exécute la macro
 Set sh1 = wb2.Sheets(1)                                                           'Valorisation de la variable Feuille 1 "sh1" du Classeur "wb1" (Feuil1 = Resultat)
 n = wb1.Sheets.Count                                                              'Valorisation de la variable n = nombre de feuilles Excel dans le Classeur Excel "wb1"
 MoisReport = Month(Date) - 1                                                      'Valorisation de la variable "MoisReport" = mois en cours - 1
'------------------------------------
'Lancement de la barre de progression
'------------------------------------
Call LancerBarreProgression
ProgressionEnCours = CompteurFichiers / Compter_Fichiers
LargeurBarre = ufProgression.Bordure.Width * ProgressionEnCours
PourcentageProgression = Round(ProgressionEnCours * 100, 0)
ufProgression.BarreDeProgression.Width = LargeurBarre
ufProgression.Texte.Caption = PourcentageProgression & " % exécuté"
DoEvents
'---------------------------
'Report des encours CT & MLT
'---------------------------
 For Col = 2 To sh1.Cells(1, sh1.Cells.Columns.Count).End(xlToLeft).Column
  NomSource = sh1.Cells(1, Col).Value
   For i = 1 To n
    NomCible = wb1.Sheets(i).Name
     If NomSource = NomCible Then
       j = sh1.Range("A" & Rows.Count).End(xlUp).Row
        For k = 2 To j
         RubriqueSource = sh1.Cells(k, 1).Value
         Set sh2 = wb1.Sheets(NomCible)
         x = sh2.Range("A" & Rows.Count).End(xlUp).Row
         For y = 3 To x
          Cible = Application.Match(RubriqueSource, sh2.Cells(y, 1), 0)
          If Not IsError(Cible) Then
           ColMois = sh2.Cells(1, sh2.Cells.Columns.Count).End(xlToLeft).Column
            For ColCible = 3 To ColMois
             If Month(CDate(sh2.Cells(1, ColCible))) = MoisReport Then
              sh2.Cells(y, ColCible) = Application.Round(sh1.Cells(k, Col) / 1000, 0)
             End If
            Next ColCible
          End If
         Next y
        Next k
     End If
   Next i
 Next Col
 ActiveWorkbook.Save
 Fichier = Dir()
Loop
'------------------------------------------
'Affichage du temps d'exécution de la macro
'------------------------------------------
MsgBox "Temps écoulé : " & Format(Date, "hh:mm:ss:") & Right(Format(Timer - t, "#0.00"), 2)
'------------------------------------
'Fermeture de la barre de progression
'------------------------------------
Unload ufProgression
 
Application.ScreenUpdating = True
 
End Sub
'--------------------
'Barre de progression
'--------------------
Sub LancerBarreProgression()
 
 With ufProgression
  .BarreDeProgression.Width = 0
  .Texte.Caption = "% exécuté"
  .Show vbModeless
 End With
 
End Sub
'------------------------------------
'Comptage du nombre de fichiers .xlsx
'------------------------------------
Function Compter_Fichiers()
Dim Chemin As String
Dim Rep As String
Dim NbFichiers As Integer
 
Chemin = ThisWorkbook.Path & "\"
Rep = Dir(Chemin & "*.xlsx*")
While Not Rep = ""
 NbFichiers = NbFichiers + 1
 Rep = Dir()
Wend
 
Compter_Fichiers = NbFichiers
 
End Function

**ncl98** · 27/07/2020, 11h55

Re-bonjour,

Voilà comment j'ai résolu le problème. J'ai déplacé l'appel de la fonction avant la boucle de traitement des fichiers et en affectant le résultat à une variable "NombreFichiers". Le résultat de la variable "ProgressionEnCours" est une division par la variable "NombreFichiers".

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
Option Explicit
 
Sub ReportEncoursMensuels()
'------------------------------------------
'Déclaration des varialble de portée privée
'------------------------------------------
Dim n As Integer
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim i As Integer
Dim Col As Integer
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim NomSource As String
Dim NomCible As String
Dim RubriqueSource As String
Dim j As Integer
Dim k As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim Cible As Variant
Dim Col2 As Integer
Dim t As Long
Dim MoisReport As Integer
Dim AnnéeEncours As Integer
Dim TotalEncours As Long
Dim ColMois As Integer
Dim ColCible As Integer
Dim Chemin As String
Dim Fichier As String
Dim NombreFichiers As Integer
Dim CompteurFichiers As Integer
Dim ProgressionEnCours As Double
Dim PourcentageProgression As Double
Dim LargeurBarre As Long
 
Application.ScreenUpdating = False
 
'-----------------
'Top Chrono départ
'-----------------
t = Timer
'---------------------------------------------------
'Détermination du nombre total de fichiers à traiter
'---------------------------------------------------
NombreFichiers = Compter_Fichiers
'-------------------------------------------------------------------------------------------
'Boucle sur tous les fichiers du répertoire de travail pour compléter les tableaux d'encours
'-------------------------------------------------------------------------------------------
Chemin = ThisWorkbook.Path & "\"                                                   'Définition du répertoire contenant les fichiers à traiter (Variable "Chemin")
Fichier = Dir(Chemin & "*.xlsx")                                                   'Sélection de chaque fichier "xlsx" du répertoire de travail (Variable "Fichier")
Do While Len(Fichier) > 0                                                          'Début de la boucle, tant qu'il existe un fichier avec l'extension "xlsx"
 Set wb1 = Workbooks.Open(Chemin & Fichier)                                        'Valorisation de la variable Classeur Excel "wb1" à mettre à jour
 CompteurFichiers = CompteurFichiers + 1                                           'Compteur nombre de fichiers traités
 Set wb2 = ThisWorkbook                                                            'Valorisation de la variable Classeur Excel "wb2" dans lequel s'exécute la macro
 Set sh1 = wb2.Sheets(1)                                                           'Valorisation de la variable Feuille 1 "sh1" du Classeur "wb1" (Feuil1 = Resultat)
 n = wb1.Sheets.Count                                                              'Valorisation de la variable n = nombre de feuilles Excel dans le Classeur Excel "wb1"
 MoisReport = Month(Date) - 1                                                      'Valorisation de la variable "MoisReport" = mois en cours - 1
'------------------------------------
'Lancement de la barre de progression
'------------------------------------
Call LancerBarreProgression
ProgressionEnCours = CompteurFichiers / NombreFichiers
LargeurBarre = ufProgression.Bordure.Width * ProgressionEnCours
PourcentageProgression = Round(ProgressionEnCours * 100, 0)
ufProgression.BarreDeProgression.Width = LargeurBarre
ufProgression.Texte.Caption = PourcentageProgression & " % exécuté"
DoEvents
'---------------------------
'Report des encours CT & MLT
'---------------------------
 For Col = 2 To sh1.Cells(1, sh1.Cells.Columns.Count).End(xlToLeft).Column
  NomSource = sh1.Cells(1, Col).Value
   For i = 1 To n
    NomCible = wb1.Sheets(i).Name
     If NomSource = NomCible Then
       j = sh1.Range("A" & Rows.Count).End(xlUp).Row
        For k = 2 To j
         RubriqueSource = sh1.Cells(k, 1).Value
         Set sh2 = wb1.Sheets(NomCible)
         x = sh2.Range("A" & Rows.Count).End(xlUp).Row
         For y = 3 To x
          Cible = Application.Match(RubriqueSource, sh2.Cells(y, 1), 0)
          If Not IsError(Cible) Then
           ColMois = sh2.Cells(1, sh2.Cells.Columns.Count).End(xlToLeft).Column
            For ColCible = 3 To ColMois
             If Month(CDate(sh2.Cells(1, ColCible))) = MoisReport Then
              sh2.Cells(y, ColCible) = Application.Round(sh1.Cells(k, Col) / 1000, 0)
             End If
            Next ColCible
          End If
         Next y
        Next k
     End If
   Next i
 Next Col
 ActiveWorkbook.Save
 Fichier = Dir()
Loop
'------------------------------------------
'Affichage du temps d'exécution de la macro
'------------------------------------------
MsgBox "Temps écoulé : " & Format(Date, "hh:mm:ss:") & Right(Format(Timer - t, "#0.00"), 2)
'------------------------------------
'Fermeture de la barre de progression
'------------------------------------
Unload ufProgression
 
Application.ScreenUpdating = True
 
End Sub
'--------------------
'Barre de progression
'--------------------
Sub LancerBarreProgression()
 
 With ufProgression
  .BarreDeProgression.Width = 0
  .Texte.Caption = "% exécuté"
  .Show vbModeless
 End With
 
End Sub
'------------------------------------
'Comptage du nombre de fichiers .xlsx
'------------------------------------
Function Compter_Fichiers()
Dim Chemin As String
Dim Rep As String
Dim NbFichiers As Integer
 
Chemin = ThisWorkbook.Path & "\"
Rep = Dir(Chemin & "*.xlsx")
While Not Rep = ""
 NbFichiers = NbFichiers + 1
 Rep = Dir()
Wend
 
Compter_Fichiers = NbFichiers
 
End Function

Boucle sur les fichiers d'un répertoire, comptage du nombre de fichiers et barre de progression [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager