Bonjour,

J'ai une macro qui ouvre des fichiers et qui récupère les données qui sont dedans.
Pour faire patienter l'utilisateur, j'ai mis une progressbar.
Le tout fonctionne bien, j'ai seulement plusieur problèmes de l'ordre de l'optimisation:

1: Mes classeurs ouvert ne sont pas ouverts en lecture seule : comment faire?
2: Les classeurs ouverts sont visibles, ils apparaisent parfois à l'ecran et j'aimerai que cela n'arrive pas: comment faire?
3:Je ferme mes classeurs avec .close, seulement quand je suis dans le visual basic editor, les macros sont tjs visibles dedans, le fichier n'est donc pas proprement fermé: comment y remedier?

Voici le code; il est long, mais la partie centrale traite les données, donc tout ce qui est entre
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
For Each Wksheet In fsource.Worksheets
Next Wksheet
n'est pas interressant
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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
Sub recupdonnées()
 
 
Dim fdest As Worksheet
Dim Wksheet As Worksheet
Dim fsource As Excel.Workbook
Dim DerLigne As Long, nbligne As Long, ldest As Long, i As Long, j As Long, dcelpleine As Long
Dim Objectif As Variant
Dim nom As String
Dim test As Boolean
Dim feuillsource As String
Dim Classeursource As String
Dim Tableau As Variant
Dim l As Long
 
Set fdest = ThisWorkbook.Worksheets(1)
 
Tableau = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xls", , , , True)
 
If IsArray(Tableau) Then
 
    For l = 1 To UBound(Tableau)
 
        Set fsource = GetObject(Tableau(l))
        Classeursource = fsource.Name
 
        Load UserForm2
        UserForm2.ProgressBar1.Max = fsource.Worksheets.Count
        UserForm2.Caption = "Traitement du fichier " & fsource.Name & " en cours"
        UserForm2.Show
        k = 0
 
        'Call clear
 
        For Each Wksheet In fsource.Worksheets
 
        Application.ScreenUpdating = False
 
        On Error GoTo fsuivante
 
        Select Case Wksheet.Name
 
            Case Is = "Feuille de Saisie"
            Case Is = "Feuil1"
            Case Else
 
            feuillesource = Wksheet.Name
 
            If Workbooks(Classeursource).Worksheets(feuillesource).CheckBox1 = False Then
 
                DerLigne = Wksheet.Range("A69").End(xlUp).Row
                nbligne = ((DerLigne - 15) / 2) + 1
 
                If nbligne = 0 Then
 
                Objectif = Wksheet.Cells(11, 9).Value
                nom = Wksheet.Range("A3").Value
                dcelpleine = fdest.Range("B65536").End(xlUp).Row
 
                If dcelpleine = 1 Then
                ldest = 1
                Else
                ldest = dcelpleine + 2
                End If
 
                Cells(ldest + 1, 1).Value = "Semaine"
                Cells(ldest + 2, 1).Value = "Réalisé"
                Cells(ldest + 3, 1).Value = "Cumul Réalisé"
                Cells(ldest + 4, 1).Value = "RAF"
                Cells(ldest + 5, 1).Value = "% Réalisé"
                Cells(ldest + 6, 1).Value = "% Chiffrage"
                Cells(ldest + 1, 2).Value = ""
                Cells(ldest + 2, 2).Value = 0
                Cells(ldest + 3, 2).Value = 0
                Cells(ldest + 4, 2).Value = Objectif
                Cells(ldest + 5, 2).Value = 0
                Cells(ldest + 6, 2).Value = 0
                Cells(ldest + 1, 3).Value = ""
                Cells(ldest + 2, 3).Value = Objectif
                Cells(ldest + 3, 3).Value = Objectif
                Cells(ldest + 4, 3).Value = 0
                Cells(ldest + 5, 3).Value = 100
                Cells(ldest + 6, 3).Value = 100
 
                fdest.Range(Cells(ldest, 2), Cells(ldest, nbligne + 3)).Merge
 
                With Cells(ldest, 2)
                .Value = nom
                .Interior.ColorIndex = 36
                End With
                With Cells(ldest, 1)
                .Value = Objectif
                .Interior.ColorIndex = 37
                End With
 
                With Range(Cells(ldest, 1), Cells(ldest + 6, nbligne + 3))
                .Borders.LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlMedium
                .Borders(xlEdgeLeft).Weight = xlMedium
                .Borders(xlEdgeRight).Weight = xlMedium
                .Borders(xlEdgeTop).Weight = xlMedium
                .Borders(xlInsideHorizontal).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                End With
 
                GoTo fsuivante
 
                Else
 
                Objectif = Wksheet.Cells(11, 9).Value
                nom = Wksheet.Range("A3").Value
                dcelpleine = fdest.Range("B65536").End(xlUp).Row
 
                If dcelpleine = 1 Then
                ldest = 2
                Else
                ldest = dcelpleine + 2
                End If
 
                Cells(ldest + 1, 1).Value = "Semaine"
                Cells(ldest + 2, 1).Value = "Réalisé"
                Cells(ldest + 3, 1).Value = "Cumul Réalisé"
                Cells(ldest + 4, 1).Value = "RAF"
                Cells(ldest + 5, 1).Value = "% Réalisé"
                Cells(ldest + 6, 1).Value = "% Chiffrage"
                Cells(ldest + 1, 2).Value = ""
                Cells(ldest + 2, 2).Value = 0
                Cells(ldest + 3, 2).Value = 0
                Cells(ldest + 4, 2).Value = Objectif
                Cells(ldest + 5, 2).Value = 0
                Cells(ldest + 6, 2).Value = 0
 
                realise = 0
                j = 3
 
                For i = 15 To DerLigne Step 2
                    fdest.Cells(ldest + 1, j).Value = Wksheet.Cells(i, 1).Value
                    fdest.Cells(ldest + 2, j).Value = Wksheet.Cells(i, 29).Value
                    realise = realise + Wksheet.Cells(i, 29).Value
                    fdest.Cells(ldest + 3, j).Value = realise
                    fdest.Cells(ldest + 4, j).Value = Wksheet.Cells(i, 33).Value
                    fdest.Cells(ldest + 5, j).Value = Wksheet.Cells(i, 37).Value * 100
                    fdest.Cells(ldest + 6, j).Value = (realise / Objectif) * 100
                    j = j + 1
                Next i
 
                If Cells(ldest + 5, j - 1).Value = 100 Then
 
                fdest.Range(Cells(ldest, 2), Cells(ldest, nbligne + 2)).Merge
 
                With Cells(ldest, 2)
                .Value = nom
                .Interior.ColorIndex = 36
                End With
                With Cells(ldest, 1)
                .Value = Objectif
                .Interior.ColorIndex = 37
                End With
 
                With Range(Cells(ldest, 1), Cells(ldest + 6, nbligne + 2))
                .Borders.LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlMedium
                .Borders(xlEdgeLeft).Weight = xlMedium
                .Borders(xlEdgeRight).Weight = xlMedium
                .Borders(xlEdgeTop).Weight = xlMedium
                .Borders(xlInsideHorizontal).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                End With
 
                Else
 
                Cells(ldest + 2, j).Value = Cells(ldest + 4, j - 1).Value
                Cells(ldest + 3, j).Value = realise + Cells(ldest + 4, j - 1).Value
                Cells(ldest + 4, j).Value = 0
                Cells(ldest + 5, j).Value = 100
                Cells(ldest + 6, j).Value = (Cells(ldest + 3, j).Value * 100) / Objectif
 
                fdest.Range(Cells(ldest, 2), Cells(ldest, nbligne + 3)).Merge
 
                With Cells(ldest, 2)
                .Value = nom
                .Interior.ColorIndex = 36
                End With
                With Cells(ldest, 1)
                .Value = Objectif
                .Interior.ColorIndex = 37
                End With
 
                With Range(Cells(ldest, 1), Cells(ldest + 6, nbligne + 3))
                .Borders.LineStyle = xlContinuous
                .Borders(xlEdgeBottom).Weight = xlMedium
                .Borders(xlEdgeLeft).Weight = xlMedium
                .Borders(xlEdgeRight).Weight = xlMedium
                .Borders(xlEdgeTop).Weight = xlMedium
                .Borders(xlInsideHorizontal).Weight = xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                End With
 
                End If
                End If
            End If
            End Select
 
fsuivante:
        k = k + 1
        Application.ScreenUpdating = True
        UserForm2.ProgressBar1.Value = k
        Application.ScreenUpdating = False
        Next Wksheet
 
        UserForm2.Hide
        Unload UserForm2
 
    Next l
 
Else
 
    Exit Sub
 
End If
 
Application.DisplayAlerts = False
 
fsource.Close
 
fin:
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub