probleme compatibilité Macros appelant d'autres macros

**Sobas** · 07/12/2011, 09h50

Bonjour à vous le forum.

J'ai trouver cette macro sur le net qui permet d’effectuer en boucle une macro de tout les fichiers d'un dossier cible choisi. Je voudrais attacher ma macro a celle-ci.

Voici la macro permettant le traitement en boucle d'une autre macro

VOIR deuxième message

Et voici ma macro:

VOIR deuxième message

Voilà si quelqu'un peut m'aider à faire cela sa serais vraiment chouette, je vous remercie d'avance. Si de plus on peut m'indiquer ou coller et quoi modifier pour pouvoir insérer n'importe quelle autre macro à l'avenir se serais vraiment super. Je suis en excel 2010 donc en .xlsx.

Merci a vous

**ZebreLoup** · 07/12/2011, 10h08

Je ne sais pas ce que tu cherches à faire, mais je pense qu'il y a effectivement des tonnes de trucs inutiles dans ta macro.
Si tu veux te mettre un peu à VBA, je te conseille les excellents tutos pour débutants de ce site.
En particulier, regarde ce qu'est une procédure, ce qu'est une fonction, ce que sont des paramètres, des variables.
Et pour ce qui est de la manipulation des feuilles, regarde la notion des objets Worksheet, Range et leur utilisation. Il faut éviter en général de faire des Select puis de travailler sur ActiveCell.

Si tu n'as pas envie de trop te lancer en VBA mais que tu as un problème urgent à résoudre, essaie d'exposer ce que tu veux faire de manière plus complète. Je ne suis pas sûr que quelqu'un se lance dans la lecture de ta macro de 2000 lignes pour t'aider.

Et quand tu mets du code, pense à utiliser la balise Code, plutôt que la balise Citation.

**Sobas** · 07/12/2011, 13h49

Salut, j'ai nettoyé ma macro, sa reste quant même un peut indigeste:

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
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
Sub traduction_données_brutes()
 
' Touche de raccourci du clavier: Ctrl+q
'
 
'Titres des colonnes en ligne 1
 
    Columns("F:G").ClearContents
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = "DATE"
    Range("B1").FormulaR1C1 = "HEUR"
    Range("C1").FormulaR1C1 = "TEMPS ECOULE"
    Range("D1").FormulaR1C1 = "SUBJECT"
    Range("E1").FormulaR1C1 = "OBS"
 
 
    Cells.Select
    Range("G12").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F30795"), Type:=xlFillDefault
 
 
     'liste des traduction des codes
 
       Range("L2").Select
    ActiveCell.FormulaR1C1 = " Subject0"
    Range("M2").FormulaR1C1 = " Obs0"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L11"), Type:=xlFillDefault
    Range("L2:L11").Select
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M9"), Type:=xlFillDefault
    Range("M2:M9").Select
    Range("M2:M9").Copy Destination:=Range("M10")
    Range("M2:M9").Copy Destination:=Range("M18")
    Range("M2:M9").Copy Destination:=Range("M26")
    Range("M2:M9").Copy Destination:=Range("M34")
    Range("M2:M9").Copy Destination:=Range("M42")
    Range("M2:M9").Copy Destination:=Range("M50")
    Range("M2:M9").Copy Destination:=Range("M58")
    Range("M2:M9").Copy Destination:=Range("M66")
    Range("M2:M9").Copy Destination:=Range("M74")
    ActiveWindow.SmallScroll Down:=-80
    Range("L2:L11").Select
    Application.CutCopyMode = False
 
    Range("L2:L11").Copy Destination:=Range("L11")
    Range("L2:L9").FormulaR1C1 = " Subject0"
    Range("L10:L17").FormulaR1C1 = " Subject1"
    Range("L18:L25").FormulaR1C1 = " Subject2"
    Range("L26:L33").FormulaR1C1 = " Subject3"
    Range("L34:L41").FormulaR1C1 = " Subject4"
    Range("L42:L49").FormulaR1C1 = " Subject5"
    Range("L50:L57").FormulaR1C1 = " Subject6"
    Range("L58:L65").FormulaR1C1 = " Subject7"
    Range("L66:L73").FormulaR1C1 = " Subject8"
    Range("L74:L81").FormulaR1C1 = " Subject9"
 
 
 
    Range("L74:L81").Select
 
    ActiveWindow.SmallScroll Down:=-95
    Range("N2").FormulaR1C1 = "D"
    Range("N3").FormulaR1C1 = "R"
    Range("N4").FormulaR1C1 = "AFFI"
    Range("N5").FormulaR1C1 = "CLINEX"
    Range("N6").FormulaR1C1 = "MONO"
    Range("N7").FormulaR1C1 = "M20"
    Range("N8").FormulaR1C1 = "274"
    Range("N9").FormulaR1C1 = "360"
    Range("N10").FormulaR1C1 = "ET"
    Range("N11").FormulaR1C1 = "MORDRE"
    Range("N12").FormulaR1C1 = "SG"
    Range("N13").FormulaR1C1 = "KO"
    Range("N14").FormulaR1C1 = "G403"
    Range("N15").FormulaR1C1 = "NEZ"
    Range("N16").FormulaR1C1 = "277"
    Range("N17").FormulaR1C1 = "PUNK"
    Range("N18").FormulaR1C1 = "FO"
    Range("N19").FormulaR1C1 = "PRESENT"
    Range("N20").FormulaR1C1 = "DEF"
    Range("N21").FormulaR1C1 = "ZORO"
    Range("N22").FormulaR1C1 = "LIPS"
    Range("N23").FormulaR1C1 = "P40"
    Range("N24").FormulaR1C1 = "EPIS"
    Range("N25").FormulaR1C1 = "G400"
    Range("N26").FormulaR1C1 = "VOC"
    Range("N27").FormulaR1C1 = "GENITAL"
    Range("N28").FormulaR1C1 = "BB"
    Range("N29").FormulaR1C1 = "2F"
    Range("N30").FormulaR1C1 = "BOITE"
    Range("N31").FormulaR1C1 = "E66"
    Range("N32").FormulaR1C1 = "ZORO"
    Range("N33").FormulaR1C1 = "MARILIN"
    Range("N34").FormulaR1C1 = "MIMIC"
    Range("N35").FormulaR1C1 = "MONTE"
    Range("N36").FormulaR1C1 = "COPU"
    Range("N37").FormulaR1C1 = "COJAK"
    Range("N38").FormulaR1C1 = "ARTHUR"
    Range("N39").FormulaR1C1 = "160"
    Range("N40").FormulaR1C1 = "A330"
    Range("N41").FormulaR1C1 = "K431"
    Range("N42").FormulaR1C1 = "CHARGE"
    Range("N43").FormulaR1C1 = "ATAQ"
    Range("N44").FormulaR1C1 = "VOISIN"
    Range("N45").FormulaR1C1 = "ALPHA"
    Range("N46").FormulaR1C1 = "VIN"
    Range("N47").FormulaR1C1 = "2L"
    Range("N48").FormulaR1C1 = "NEIG"
    Range("N49").FormulaR1C1 = "L11"
    Range("N50").FormulaR1C1 = "SUP"
    Range("N51").FormulaR1C1 = "ALOG"
    Range("N52").FormulaR1C1 = "FLIP"
    Range("N53").FormulaR1C1 = "MERT"
    Range("N54").FormulaR1C1 = "BOITE"
    Range("N55").FormulaR1C1 = "NARINE"
    Range("N56").FormulaR1C1 = "MARILIN"
    Range("N57").FormulaR1C1 = "M21"
    Range("N58").FormulaR1C1 = "POUR"
    Range("N59").FormulaR1C1 = "JOUER"
    Range("N60").FormulaR1C1 = "ALDO"
    Range("N61").FormulaR1C1 = "DIGIT"
    Range("N62").FormulaR1C1 = "PELE"
    Range("N63").FormulaR1C1 = "203"
    Range("N64").FormulaR1C1 = "ALPHAF"
    Range("N65").FormulaR1C1 = "O30"
    Range("N66").FormulaR1C1 = "FRAPER"
    Range("N67").FormulaR1C1 = "REPOC"
    Range("N68").FormulaR1C1 = "FK"
    Range("N69").FormulaR1C1 = "QAZI"
    Range("N70").FormulaR1C1 = "L10"
    Range("N71").FormulaR1C1 = "PP"
    Range("N72").FormulaR1C1 = "DIANA"
    Range("N73").FormulaR1C1 = "FOFOL"
    Range("N74").FormulaR1C1 = "ATRAPER"
    Range("N75").FormulaR1C1 = "TRYADE"
    Range("N76").FormulaR1C1 = "REMS"
    Range("N77").FormulaR1C1 = "FRER"
    Range("N78").FormulaR1C1 = "AL"
    Range("N79").FormulaR1C1 = "PIRAT"
    Range("N80").FormulaR1C1 = "2T"
    Range("N81").FormulaR1C1 = "STOP"
 
'Mise en forme dans une seconde feuille
 
    Range("L2:M81").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-20
    Range("K2").Select
    ActiveSheet.Paste
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M81"), Type:=xlFillDefault
    Range("M2:M81").Select
    ActiveWindow.SmallScroll Down:=-95
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE))"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE))"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G44285"), Type:=xlFillDefault
    Range("G2").Select
    ActiveWindow.SmallScroll Down:=-30
    ActiveWindow.ScrollRow = 1
 
 
    Range("A1:G155").Select
 
    ActiveWindow.ScrollRow = 1
    Columns("A:G").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("H5").Select
    Sheets("Feuil1").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("F8").Select
 
 
 
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TEMPSVAL5"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TIMEVALUE(R2C[-3])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E20000"), Type:=xlFillDefault
    Range("E2").Select
 
    ActiveWindow.ScrollRow = 1
    Columns("E:E").Select
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
    Selection.Copy
    Columns("F:F").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
 
       Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Columns("B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
 
   'je ne sais pas pourquoi je dois obligatoirement choisir une ligne et non juste la colonne!!
   'se qui me fait ralentire concidérablement ma macro à l'exécution!
   's'il est possible de modifier ça sa serais super
 
   Dim I As Long
For I = Sheets("Feuil2").Cells(99999, 2).End(xlUp).Row To 1 Step -1
If Sheets("Feuil2").Cells(I, 2).Text = "#VALEUR!" Then Sheets("Feuil2").Cells(I, 2).ClearContents
Next I
 
    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("A:B").Select
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Timed"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "D R "
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "VOC MIMIC CHARGE SUP POUR FRAPER ATRAPER MORDRE GENITAL MONTE "
    Range("A5").FormulaR1C1 = "AFFI SG "
    Range("A6").FormulaR1C1 = "ATAS DEF"
    Range("A7").FormulaR1C1 = "BB"
    Range("A8").FormulaR1C1 = "COPU"
    Range("A9").FormulaR1C1 = "VOISIN"
    Range("A10").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A11").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A12").FormulaR1C1 = " "
    Rows("10:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A14").FormulaR1C1 = "Individuos Machos ("
    Range("A11").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A14").FormulaR1C1 = _
        "Individuos Machos (FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40)"
    Range("A15").FormulaR1C1 = "Individuos Embras ("
    Range("A12").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A15").FormulaR1C1 = _
        "Individuos Embras (E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL)"
    Range("A16").FormulaR1C1 = "DIA"
    Range("A17").FormulaR1C1 = "HORA "
    Range("A18").FormulaR1C1 = "SEXO"
 
 
 
    Sheets("Feuil2").Select
    Range("A1:B20000").Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A23").Select
    ActiveSheet.Paste
 
 
 
    Dim Lg&, A As Long
        Application.ScreenUpdating = False
        Lg = Range("b" & Rows.Count).End(xlUp).Row + 1
 
        With Sheets("Feuil3")
            For A = 24 To Lg
                If .Cells(A, "b") = "" And .Cells(A, "a") <> "/" Then .Cells(A, "a") = "/"
            Next A
        End With
 
   Sheets("Feuil2").Select
 
 
 
        Columns("A:A").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

Par contre se que je voudrais c que cette macro qui est sensé lancé une macro au choix, me lance la mienne, je pensé qu'un simple copier coller aurai suffis, mais non..., voici la macro sensé faire des boucles sur l'ensemble des fichier du dossier cible. Il est uniquement fait pour des fichier .xls, etant sur excel 2010 j'ai des .xlsx:

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
 Public Chemin, Fich As String, ReponseMsgBox As Variant

    '                                           .
    'routine d'appel depuis le bouton sur feuille
    '                                           .
    Public Sub SelectionnerRepertoire()
    Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & ""
    DoEvents
    'demande de confirmation
    M$ = "Traiter tous les Fichiers xls du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
    ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
    If ReponseMsgBox = vbYes Then
       BoucleDeTraitement ' appel la routine de traitement des fichiers
      MsgBox "Traitement terminé !", vbInformation
    Else
       MsgBox "Traitement abandonné !", vbExclamation
    End If
    End Sub

    ' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
    'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
    Private Function FLoadNomDuREP() As String
    Dim objShell As Object, objFolder As Object, REP As String
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
    If Not objFolder Is Nothing Then
       REP = objFolder.Items.Item.Path
       If Right(REP, 1) <> "" Then REP = REP & ""
    End If
    FLoadNomDuREP = REP
    Set objShell = Nothing: Set objFolder = Nothing
    End Function

    '                                                                               .
    '                                                                               .

    Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
    Application.ScreenUpdating = False
    ChDir Chemin
    Fich = Dir(Chemin & "*.xls")
    Do While Fich <> ""
      Workbooks.Open Chemin & Fich
      Test 'ICI C'EST L'APPELLE DE LA MACRO A FAIRE TOURNER EN BOUCLE      ActiveWorkbook.Close True
      Fich = Dir
    Loop
    Application.ScreenUpdating = True
    End Sub

P.S j'ai supprimé les codes précédant

Voici ci joint un fichier type pour voir se que fait ma macro. Mais, il ne s'agit pas de modifier quoi que se soit mais de l'intégrer à la macro, pour un traitement en boucle de mes fichiers (1600).

P.S: Merci pour les infos, je me fais de ce pas regarder.

**Sobas** · 07/12/2011, 14h56

Bon alors, j'ai réussis à "fusionner les deux macro pour réaliser en boucle le traitement. Pour cela j'ai changé là où il y avait xls par xlsx puis changé le nom de la macro à appeler par le mien. Mais le problème est que je n'obtient pas du tout le même résultat qu'avec ma macro effectué sur un seul dossier. De plus la boucle qui est sensé traité tout les fichier n'en traite que un seul.
Voici les deux macro fusionné:

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
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
Public Chemin, Fich As String, ReponseMsgBox As Variant
 
'                                           .
'routine d'appel depuis le bouton sur feuille
'                                           .
Public Sub SelectionnerRepertoire()
Chemin = FLoadNomDuREP: Chemin = Trim(Chemin): If Chemin = "" Then Exit Sub
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
DoEvents
'demande de confirmation
M$ = "Traiter tous les Fichiers xlsx du répertoire suivant :" & vbLf & Chemin & vbLf & vbLf & "Veuillez confirmer ?"
ReponseMsgBox = MsgBox(M$, vbQuestion + vbYesNo, "Traitement des fichiers")
If ReponseMsgBox = vbYes Then
   BoucleDeTraitement ' appel la routine de traitement des fichiers
   MsgBox "Traitement terminé !", vbInformation
Else
   MsgBox "Traitement abandonné !", vbExclamation
End If
End Sub
 
' , &H1&)=avec bouton "créer un nouveau dossier" ... , $H201&)=sans le bouton
'objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&, RepDefaut)
Private Function FLoadNomDuREP() As String
Dim objShell As Object, objFolder As Object, REP As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Sélectionnez un dossier", &H201&)
If Not objFolder Is Nothing Then
   REP = objFolder.Items.Item.Path
   If Right(REP, 1) <> "\" Then REP = REP & "\"
End If
FLoadNomDuREP = REP
Set objShell = Nothing: Set objFolder = Nothing
End Function
 
'                                                                               .
'                                                                               .
 
Private Sub BoucleDeTraitement() ' la boucle de traitement des fichiers
Application.ScreenUpdating = False
ChDir Chemin
Fich = Dir(Chemin & "*.xlsx")
Do While Fich <> ""
  Workbooks.Open Chemin & Fich
  traduction_données_brutes
  ActiveWorkbook.Close True
  Fich = Dir
Loop
Application.ScreenUpdating = True
End Sub
 
 
Sub traduction_données_brutes()
 
' Touche de raccourci du clavier: Ctrl+q
'
 
'Titres des colonnes en ligne 1
 
    Columns("F:G").ClearContents
    Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").FormulaR1C1 = "DATE"
    Range("B1").FormulaR1C1 = "HEUR"
    Range("C1").FormulaR1C1 = "TEMPS ECOULE"
    Range("D1").FormulaR1C1 = "SUBJECT"
    Range("E1").FormulaR1C1 = "OBS"
 
 
    Cells.Select
    Range("G12").Activate
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    Range("F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F30795"), Type:=xlFillDefault
 
 
     'liste des traduction des codes
 
       Range("L2").Select
    ActiveCell.FormulaR1C1 = " Subject0"
    Range("M2").FormulaR1C1 = " Obs0"
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L11"), Type:=xlFillDefault
    Range("L2:L11").Select
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M9"), Type:=xlFillDefault
    Range("M2:M9").Select
    Range("M2:M9").Copy Destination:=Range("M10")
    Range("M2:M9").Copy Destination:=Range("M18")
    Range("M2:M9").Copy Destination:=Range("M26")
    Range("M2:M9").Copy Destination:=Range("M34")
    Range("M2:M9").Copy Destination:=Range("M42")
    Range("M2:M9").Copy Destination:=Range("M50")
    Range("M2:M9").Copy Destination:=Range("M58")
    Range("M2:M9").Copy Destination:=Range("M66")
    Range("M2:M9").Copy Destination:=Range("M74")
    ActiveWindow.SmallScroll Down:=-80
    Range("L2:L11").Select
    Application.CutCopyMode = False
 
    Range("L2:L11").Copy Destination:=Range("L11")
    Range("L2:L9").FormulaR1C1 = " Subject0"
    Range("L10:L17").FormulaR1C1 = " Subject1"
    Range("L18:L25").FormulaR1C1 = " Subject2"
    Range("L26:L33").FormulaR1C1 = " Subject3"
    Range("L34:L41").FormulaR1C1 = " Subject4"
    Range("L42:L49").FormulaR1C1 = " Subject5"
    Range("L50:L57").FormulaR1C1 = " Subject6"
    Range("L58:L65").FormulaR1C1 = " Subject7"
    Range("L66:L73").FormulaR1C1 = " Subject8"
    Range("L74:L81").FormulaR1C1 = " Subject9"
 
 
 
    Range("L74:L81").Select
 
    ActiveWindow.SmallScroll Down:=-95
    Range("N2").FormulaR1C1 = "D"
    Range("N3").FormulaR1C1 = "R"
    Range("N4").FormulaR1C1 = "AFFI"
    Range("N5").FormulaR1C1 = "CLINEX"
    Range("N6").FormulaR1C1 = "MONO"
    Range("N7").FormulaR1C1 = "M20"
    Range("N8").FormulaR1C1 = "274"
    Range("N9").FormulaR1C1 = "360"
    Range("N10").FormulaR1C1 = "ET"
    Range("N11").FormulaR1C1 = "MORDRE"
    Range("N12").FormulaR1C1 = "SG"
    Range("N13").FormulaR1C1 = "KO"
    Range("N14").FormulaR1C1 = "G403"
    Range("N15").FormulaR1C1 = "NEZ"
    Range("N16").FormulaR1C1 = "277"
    Range("N17").FormulaR1C1 = "PUNK"
    Range("N18").FormulaR1C1 = "FO"
    Range("N19").FormulaR1C1 = "PRESENT"
    Range("N20").FormulaR1C1 = "DEF"
    Range("N21").FormulaR1C1 = "ZORO"
    Range("N22").FormulaR1C1 = "LIPS"
    Range("N23").FormulaR1C1 = "P40"
    Range("N24").FormulaR1C1 = "EPIS"
    Range("N25").FormulaR1C1 = "G400"
    Range("N26").FormulaR1C1 = "VOC"
    Range("N27").FormulaR1C1 = "GENITAL"
    Range("N28").FormulaR1C1 = "BB"
    Range("N29").FormulaR1C1 = "2F"
    Range("N30").FormulaR1C1 = "BOITE"
    Range("N31").FormulaR1C1 = "E66"
    Range("N32").FormulaR1C1 = "ZORO"
    Range("N33").FormulaR1C1 = "MARILIN"
    Range("N34").FormulaR1C1 = "MIMIC"
    Range("N35").FormulaR1C1 = "MONTE"
    Range("N36").FormulaR1C1 = "COPU"
    Range("N37").FormulaR1C1 = "COJAK"
    Range("N38").FormulaR1C1 = "ARTHUR"
    Range("N39").FormulaR1C1 = "160"
    Range("N40").FormulaR1C1 = "A330"
    Range("N41").FormulaR1C1 = "K431"
    Range("N42").FormulaR1C1 = "CHARGE"
    Range("N43").FormulaR1C1 = "ATAQ"
    Range("N44").FormulaR1C1 = "VOISIN"
    Range("N45").FormulaR1C1 = "ALPHA"
    Range("N46").FormulaR1C1 = "VIN"
    Range("N47").FormulaR1C1 = "2L"
    Range("N48").FormulaR1C1 = "NEIG"
    Range("N49").FormulaR1C1 = "L11"
    Range("N50").FormulaR1C1 = "SUP"
    Range("N51").FormulaR1C1 = "ALOG"
    Range("N52").FormulaR1C1 = "FLIP"
    Range("N53").FormulaR1C1 = "MERT"
    Range("N54").FormulaR1C1 = "BOITE"
    Range("N55").FormulaR1C1 = "NARINE"
    Range("N56").FormulaR1C1 = "MARILIN"
    Range("N57").FormulaR1C1 = "M21"
    Range("N58").FormulaR1C1 = "POUR"
    Range("N59").FormulaR1C1 = "JOUER"
    Range("N60").FormulaR1C1 = "ALDO"
    Range("N61").FormulaR1C1 = "DIGIT"
    Range("N62").FormulaR1C1 = "PELE"
    Range("N63").FormulaR1C1 = "203"
    Range("N64").FormulaR1C1 = "ALPHAF"
    Range("N65").FormulaR1C1 = "O30"
    Range("N66").FormulaR1C1 = "FRAPER"
    Range("N67").FormulaR1C1 = "REPOC"
    Range("N68").FormulaR1C1 = "FK"
    Range("N69").FormulaR1C1 = "QAZI"
    Range("N70").FormulaR1C1 = "L10"
    Range("N71").FormulaR1C1 = "PP"
    Range("N72").FormulaR1C1 = "DIANA"
    Range("N73").FormulaR1C1 = "FOFOL"
    Range("N74").FormulaR1C1 = "ATRAPER"
    Range("N75").FormulaR1C1 = "TRYADE"
    Range("N76").FormulaR1C1 = "REMS"
    Range("N77").FormulaR1C1 = "FRER"
    Range("N78").FormulaR1C1 = "AL"
    Range("N79").FormulaR1C1 = "PIRAT"
    Range("N80").FormulaR1C1 = "2T"
    Range("N81").FormulaR1C1 = "STOP"
 
'Mise en forme dans une seconde feuille
 
    Range("L2:M81").Select
    Selection.Cut
    ActiveWindow.SmallScroll Down:=-20
    Range("K2").Select
    ActiveSheet.Paste
    Range("M2").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    Range("M2").Select
    Selection.AutoFill Destination:=Range("M2:M81"), Type:=xlFillDefault
    Range("M2:M81").Select
    ActiveWindow.SmallScroll Down:=-95
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C12:R81C14,2,FALSE))"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISNA(VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE)),"""",VLOOKUP(RC[-3]&RC[-2],R2C13:R81C14,2,FALSE))"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G44285"), Type:=xlFillDefault
    Range("G2").Select
    ActiveWindow.SmallScroll Down:=-30
    ActiveWindow.ScrollRow = 1
 
 
    Range("A1:G155").Select
 
    ActiveWindow.ScrollRow = 1
    Columns("A:G").Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("D:F").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("H5").Select
    Sheets("Feuil1").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Columns("A:A").Select
    ActiveSheet.Paste
    Range("F8").Select
 
 
 
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TEMPSVAL5"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TIMEVALUE(RC[-3])-TIMEVALUE(R2C[-3])"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E20000"), Type:=xlFillDefault
    Range("E2").Select
 
    ActiveWindow.ScrollRow = 1
    Columns("E:E").Select
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
    Selection.Copy
    Columns("F:F").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
 
       Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
     Columns("B").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
 
   'je ne sais pas pourquoi je dois obligatoirement choisir une ligne et non juste la colonne!!
   'se qui me fait ralentire concidérablement ma macro à l'exécution!
   's'il est possible de modifier ça sa serais super
 
   Dim I As Long
For I = Sheets("Feuil2").Cells(99999, 2).End(xlUp).Row To 1 Step -1
If Sheets("Feuil2").Cells(I, 2).Text = "#VALEUR!" Then Sheets("Feuil2").Cells(I, 2).ClearContents
Next I
 
    Sheets.Add After:=Sheets(Sheets.Count)
    Columns("A:B").Select
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "Timed"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "D R "
    Range("A4").Select
    ActiveCell.FormulaR1C1 = _
        "VOC MIMIC CHARGE SUP POUR FRAPER ATRAPER MORDRE GENITAL MONTE "
    Range("A5").FormulaR1C1 = "AFFI SG "
    Range("A6").FormulaR1C1 = "ATAS DEF"
    Range("A7").FormulaR1C1 = "BB"
    Range("A8").FormulaR1C1 = "COPU"
    Range("A9").FormulaR1C1 = "VOISIN"
    Range("A10").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A11").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A12").FormulaR1C1 = " "
    Rows("10:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A14").FormulaR1C1 = "Individuos Machos ("
    Range("A11").FormulaR1C1 = _
        "FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40"
    Range("A14").FormulaR1C1 = _
        "Individuos Machos (FLIP ALDO FK REMS CLINEX KO ZORO 2F COJAK ALPHA MERT DIGIT QAZI FRER MONO G403 LIPS BOITE ARTHUR VIN BO PELE L10 AL M20 NEZ P40)"
    Range("A15").FormulaR1C1 = "Individuos Embras ("
    Range("A12").FormulaR1C1 = _
        "E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL"
    Range("A15").FormulaR1C1 = _
        "Individuos Embras (E66 2L NARINE O203 PP PIRAT 274 277 EPIS Z A330 NEIG MA ALPHAF DIANA 2T 360 PUNK G400 MARILIN L11 M21 O30 FOFOL)"
    Range("A16").FormulaR1C1 = "DIA"
    Range("A17").FormulaR1C1 = "HORA "
    Range("A18").FormulaR1C1 = "SEXO"
 
 
 
    Sheets("Feuil2").Select
    Range("A1:B20000").Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A23").Select
    ActiveSheet.Paste
 
 
 
    Dim Lg&, A As Long
        Application.ScreenUpdating = False
        Lg = Range("b" & Rows.Count).End(xlUp).Row + 1
 
        With Sheets("Feuil3")
            For A = 24 To Lg
                If .Cells(A, "b") = "" And .Cells(A, "a") <> "/" Then .Cells(A, "a") = "/"
            Next A
        End With
 
   Sheets("Feuil2").Select
 
 
 
        Columns("A:A").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
End Sub

si vous comparé le résultat avec ma macro vous verrez l'énorme différence (c'est comme s'il effectué deux fois la macro en oubliant une partie).
Voilà si quelqu'un peut m'aider.
Merci

**Sobas** · 07/12/2011, 16h01

Bon c'est bon j'ai réussis a résoudre le problème je sais pas trop comment mais bon

voila, donc jusqu'à :traduction_données_brutes

il s'agit d'une macro qui appelle en boucle une macro (dans ce cas traduction_données_brutes) sur l'ensemble des fichiers du dossier cible.

Merci.

probleme compatibilité Macros appelant d'autres macros [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager