Discussion :

[Marielabeille]

Bonsoir à toutes et tous,

Je rédige des tas de documents sous Word.

En fin de rédaction, je fais toujours toute une série d'actions : mettre à jour le sommaire, le nombre de pages automatique, et puis vérifier que les espaces avant les % soient insécables, ainsi que les espaces avant les :, ceux avant ou après les guillemets français etc.

Pensez-vous qu'il est possible de créer une macro qui ferait tout ça automatiquement ? Un "bouton" que j'actionnerais et qui lancerait au moins tous les rechercher et remplacer à ma place ?

Ma contrainte est bien sûr que je ne travaille pas sur un seul document, mais sur plein de documents différents, avec des modèles différents etc. Il faudrait donc que je puisse transporter mon automatisme d'un document vers un autre.

Merci pour vos idées et conseils.

[Heureux-oli]

Salut,

Une peu de lecture ?

http://heureuxoli.developpez.com/office/word/vba-all/
http://heureuxoli.developpez.com/off...-et-remplacer/
http://heureuxoli.developpez.com/off...rd/champs/#LVI

[Marielabeille]

Ha, voilà de saines lectures pour les fêtes de fin d'année !!!

Je vais regarder ça et si j'arrive à quelque chose je reviendrai vous en faire part

[Heureux-oli]

Salut,

Même si tu n'aboutis pas du premier coup, nous te viendrons en aide pour que tu puisses y parvenir.

[Souriane]

Bonjour Marielabeille!

J'ai plusieurs petits codes qui servent à faire des parties de ce que tu souhaites. Voilà, je te les partage. Attention, ils sont adaptés pour le Canada-Français (exemple : un espace insécable avant et après le deux-points).

Tout d'abord, quand je fais des "chercher/remplacer", je fais toujours appel à cette macro pour m'assurer que la fenêtre de C/R est "vide".

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
Sub Clear_ChercherRemplacer()
'Macro appelée au début et à la fin de d'autres macros pour remettre
'le rechercher remplacer à zéro
 
    With Selection.Find
        .ClearFormatting
        .Text = ""
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .MatchAllWordForms = False
        .MatchCase = False
        .MatchSoundsLike = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .Wrap = wdFindContinue
        .Forward = True
        .Format = False
    End With
 
End Sub

Celui-ci gère l'espace insécable dans les dates en français ET en anglais, ainsi que l'exposant du premier jour du mois (1er janvier 2014).

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
Sub G_Espace_Insecable_Mois_ANG_FRA()
 
'Macro qui gère l'espace insécable dans les dates
 
On Error GoTo Fin
Clear_ChercherRemplacer
 
Selection.HomeKey Unit:=wdStory
 
'(Macro créée par Sépia de Développez)
 
    Dim aTable(1 To 24) As String
    Dim ai As Byte
    Dim oRng As Range
 
    aTable(1) = "janvier"
    aTable(2) = "février"
    aTable(3) = "mars"
    aTable(4) = "avril"
    aTable(5) = "mai"
    aTable(6) = "juin"
    aTable(7) = "juillet"
    aTable(8) = "août"
    aTable(9) = "septembre"
    aTable(10) = "octobre"
    aTable(11) = "novembre"
    aTable(12) = "décembre"
    aTable(13) = "January"
    aTable(14) = "February"
    aTable(15) = "March"
    aTable(16) = "April"
    aTable(17) = "May"
    aTable(18) = "June"
    aTable(19) = "July"
    aTable(20) = "August"
    aTable(21) = "September"
    aTable(22) = "October"
    aTable(23) = "November"
    aTable(24) = "December"
 
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    '// Traitement de l'espace devant pour le français
    For ai = 1 To 12
        With Selection.Find
            .Text = "([0-9])([0-9]) (" + aTable(ai) + ")"
            .Replacement.Text = "\1\2^s\3"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
    '// Traitement de l'espace devant pour le français dans le cas du "1er" du mois
    For ai = 1 To 12
        With Selection.Find
            .Text = "(1er) (" + aTable(ai) + ")"
            .Replacement.Text = "\1^s\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
 
    '// Traitement de l'espace derrière pour le français
    For ai = 1 To 12
        With Selection.Find
            .Text = "(" + aTable(ai) + ") ([0-9])"
            .Replacement.Text = "\1^s\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
 
    '// Traitement de l'espace derrière pour l'anglais
    For ai = 13 To 24
        With Selection.Find
            .Text = "(" + aTable(ai) + ") ([0-9])"
            .Replacement.Text = "\1^s\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
 
'Traitement de l'exposant dans une date du premier du mois (ex. 1er janvier)
 
 Clear_ChercherRemplacer
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
 
    With Selection
        .HomeKey Unit:=wdStory
        With .Find
            .ClearFormatting
            .Forward = True
            .Text = "1er "
            .Execute
            While .Found
                Set oRng = ActiveDocument.Range _
                (Start:=Selection.Range.Start + 1, _
                  End:=Selection.Range.End - 1)
                oRng.Font.Superscript = True
                oRng.Start = oRng.End
                .Execute
            Wend
        End With
    End With
 
'Nettoyer la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
Fin:
End Sub

Celle-ci gère la ponctuation (espaces insecable, espace avant le :, le ?, le !, etc.)

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
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
Sub G_Espace_Insecable_et_Ponctuation()
 
'Macro qui gère la ponctuation (espaces insecable, espace avant le :, le ?, le !, etc.)
 
'Nettoyer la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
On Error GoTo Fin
 
Selection.HomeKey Unit:=wdStory
 
'Espace insécable dans les format de nombre de 1 000 et plus
With Selection.Find
.Text = "(<[0-9]{2}) ([0-9]{3})"
.Replacement.Text = "\1^s\2"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = "(<[0-9]{3}) ([0-9]{3})"
.Replacement.Text = "\1^s\2"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = "(<[0-9]{1}) ([0-9]{3})"
.Replacement.Text = "\1^s\2"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'____________________________
'Mise en forme du DEUX-POINTS
'Cherche tous les ":" et les remplace par "espace:espace"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
 
With Selection.Find
        .Text = ":"
        .Replacement.Text = " : "
        .Forward = True
        .MatchWildcards = False
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace:espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w:^w"
        .Replacement.Text = "^s: "
        .Forward = True
        .Wrap = wdFindContinue
End With
 
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = ":^w^p"
        .Replacement.Text = ":^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève les espaces dans l'heure en anglais
'
With Selection.Find
        .Text = ":"
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'____________________________
'Mise en forme du POURCENTAGE
'Cherche tous les "%" et les remplace par "espace insécable%espace"
With Selection.Find
        .Text = "%"
        .Replacement.Text = " % "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace%espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w%^w"
        .Replacement.Text = "^s% "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "%^w^p"
        .Replacement.Text = "%^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'
'Mise en forme du Dollar
'Cherche tous les "$" et les remplace par "espace insécable$espace"
With Selection.Find
        .Text = "([0-9])\$"
        .Replacement.Text = "\1^s$"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "Espace-$" et les remplace par "espace insécable$"
With Selection.Find
        .Text = "([0-9]) \$"
        .Replacement.Text = "\1^s$"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "$^w^p"
        .Replacement.Text = "$^p"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
 
'____________________________
'Mise en forme du Point d'interrogation
'Cherche tous les "?" et les remplace par "espace insécable?espace"
With Selection.Find
        .Text = "?"
        .Replacement.Text = " ? "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace?espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w?^w"
        .Replacement.Text = "^s? "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "?^w^p"
        .Replacement.Text = "?^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'____________________________
'Mise en forme du Point d'exclammation
'Cherche tous les "!" et les remplace par "espace insécable!espace"
With Selection.Find
        .Text = "!"
        .Replacement.Text = " ! "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace!espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w!^w"
        .Replacement.Text = "^s! "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "!^w^p"
        .Replacement.Text = "!^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'____________________________
'Mise en forme du Point virgule
 
'Cherche tous les "espace-espace;espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w;^p"
        .Replacement.Text = ";^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
With Selection.Find
        .Text = "^w;^w"
        .Replacement.Text = "; "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
        .Text = "; ^p"
        .Replacement.Text = ";^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'_________________________________
'Mise en forme des apostrophes
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "'"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "'"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "`"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "´"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
'_________________________________
'Mise en forme du signe du degré
 
    With Selection.Find
        .Text = "º"
        .Replacement.Text = "°"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
'_________________________________
'Mise en forme du "h" de l'heure
 
With Selection.Find
        .Text = "^wh^w"
        .Replacement.Text = "^sh^s"
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
With Selection.Find
        .Text = "^wh."
        .Replacement.Text = "^sh."
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
 
With Selection.Find
        .Text = "([0-9])h([0-9])"
        .Replacement.Text = "\1^sh^s\2"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
        .Text = "([0-9])h,"
        .Replacement.Text = "\1^sh,"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
        .Text = "([0-9])h."
        .Replacement.Text = "\1^sh."
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
 
With Selection.Find
        .Text = "^wh,"
        .Replacement.Text = "^sh,"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'Autre
 
 
With Selection.Find
.Text = "( "
.Replacement.Text = "("
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = " )"
.Replacement.Text = ")"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = " ,"
.Replacement.Text = ","
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = " ."
.Replacement.Text = "."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
Selection.HomeKey Unit:=wdStory
  Do
    Selection.Find.ClearFormatting
    Selection.Find.Text = "\"
    Selection.Find.Execute
    If Selection.Find.Found = False Then
'rien
    Else
 
Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^~"
        .Replacement.Text = "-"
        .Forward = True
        .Wrap = wdFindStop
 
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "^s: "
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindStop
 
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
 
    With Selection.Find
        .Text = "^s"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindStop
 
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
 
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.Find.Text = "\"
    Selection.Find.Execute
 
  Loop While Selection.Find.Found = True
 
'Nettoyer la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
 
Fin:
End Sub

Celle-ci enlève tous les espaces en trop. Par exemple, des espaces avant un retour de ligne, ou encore un espace après l'ouverture d'une parenthèse, etc. Elle duplique certaine tâche déjà fait par les macros ci-dessous mais elle est bien utile quand même. Attention, il faut que ton document ait été fait selon "les règles de l'art". Par exemple, il faut avoir utilisé la touche de tabulation et non avoir insérer une dizaine d'espace pour faire une tabulation.

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
Sub GC_Ponctuation()
'
'
' Macro enregistrée le 2009-06-19 par Guylaine Constant
'
ActiveDocument.Content.Find.Execute _
    FindText:=".  ", _
    ReplaceWith:=". ", _
Replace:=wdReplaceAll
 
ActiveDocument.Content.Find.Execute FindText:="^w.", ReplaceWith:=".", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w^p", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=":", ReplaceWith:="^s:", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w:", ReplaceWith:="^s:", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  (", ReplaceWith:=" (", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=")  ", ReplaceWith:=") ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="(^w", ReplaceWith:="(", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w)", ReplaceWith:=")", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w,", ReplaceWith:=",", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=",", ReplaceWith:=", ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=",  ", ReplaceWith:=", ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w!", ReplaceWith:="!", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w;", ReplaceWith:=";", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=";  ", ReplaceWith:="; ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="ect.", ReplaceWith:="etc.", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="etc…", ReplaceWith:="etc.", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^0171", ReplaceWith:="^0171^s", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^0171  ", ReplaceWith:="^0171^s", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^0187", ReplaceWith:="^s^0187", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  ^0187", ReplaceWith:="^s^0187", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w'", ReplaceWith:="'", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="%", ReplaceWith:="^s%", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  %", ReplaceWith:="^s%", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w?", ReplaceWith:="?", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="$", ReplaceWith:="^s$", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  $", ReplaceWith:="^s$", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=" jour", ReplaceWith:="^sjour", Replace:=wdReplaceAll
 
 
'Vider la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
 
End Sub

N'oublie pas, ce n'est pas parce que des macros font le boulot à notre place qu'il ne faut pas se revérifier. Comme par exemple, la dernière macro, dans le cas d'un chemin de réseau (ex: c:\test) va modifier le chemin pour "c : \test" Donc il faut se réviser et adapter la macro à sa propre situation

J'espère que ces codes te seront utiles.

Bonne chance!

Souriane

[Rockveleur]

Bonjour Marielabeille, Heureuxoli et Souriane

Merci pour vos réponses édifiantes !

Désoler de déterrer ce fil, mais il correspond parfaitement à ma demande, je relis des livres afin de les parfaire avant de toutes petites réédition.

Il est étonnant de ne pas trouver grand chose sur internet... à part cette discussion ! Comme si nous étions les seuls à avoir besoin de ça.


préambule

Les textes sont souvent abimés suite aux corrections faites dans le texte, sans afficher les caractères invisibles et sans prendre garde aux insécables etc.

dans un volume, il peut y avoir 3000 insécables à vérifier pour les guillemets, les ? ! ; : etc. je m'épuise !

présentation de moi...

- je ne code pas mais je bricode (copier/coller, modifier)
- j'ai fait un peu de VBA mais toujours par des enregistrements de macros et du bricodage
- ma langue est le français de France

où j'en suis

j'ai commencer à lister les contrôles/corrections à faire et essayer de les tenter en macro/enregistrer

J'ai commencé à faire quelques parties de macro, à partir de RR

- trouver les espaces avant ? et remplacer l'espace sécable par insécable OK et d'autres : doublettes d'espaces, doublettes de point, etc. etc.

donc ma question vient sur le message suivant

Cordialement

[Rockveleur]

J'ai bien quelques macros mais ça ne fonctionne pas.
- soit la dernière lettre du mot est mangée
- soit chaque relance de macro ajoute encore et encore un insécable de plus
- soit rien n'est effectué...

Et déja quelques heures à chercher...

Veux tu une bonne bière? >>> bière°?

Sinon dans cette discussion vous êtes 2 à avoir travaillé un outil complet, serai-t-il disponible ?

[Souriane]

Bonjour Rockveleur,

Je sais pas quoi vous donner plus que les codes que je vous ai donné plus haut... ils sont sensé vers le travail! En tout cas, chez-moi, oui!

Dites-moi exactement ce que mes codes ne font pas ou font en trop, je pourrai mieux vous aider. Ou encore montrez-moi votre code, je pourrais voir ce qui cloche.

Souriane

[Rockveleur]

Bonsoir Souriane,

j'avais commencé une macro qui s'occupe des insécables, avant de trouver cette discussion

ce soir j'ai étudié vos codes et placé mes commentaires pour comprendre la structure.

puis j'ai créé la macro principale pour la tester mais elle stoppe et réclame End Sub , qui pourtant semble présent.

je chercherai mon erreur, on verra demain. C'est sympa d'avoir répondu :-)

[Rockveleur]

Bonjour

N'ayant que 30 heures de vol en vba pour Word Rechercher-Remplacer, j'aimerais un petit coup de clavier pour :

Dans Word macros, je lance des RR pour la correction des erreurs de syntaxe.

Afin de vérifier les modifications effectuées par la macro lancée, j'aimerais que dans un volume traité par la macro, toute zone modifiée soit mise en évidence.

(les critères de recherche et les valeurs de remplacement touchent 3 caractères maxi.)

J'aimerais une mise en couleur de fond qui mette en évidence 4 caractères à droite et à gauche de la zone de recherche trouvée et donc modifiée.

Ainsi même une zone supprimée resterait visible.

Voilà, la bouteille est lançée

[Rockveleur]

Bonjour Rockveleur,

Je sais pas quoi vous donner plus que les codes que je vous ai donné plus haut... ils sont sensé vers le travail! En tout cas, chez-moi, oui!

Dites-moi exactement ce que mes codes ne font pas ou font en trop, je pourrai mieux vous aider. Ou encore montrez-moi votre code, je pourrais voir ce qui cloche.

Souriane

Bonsoir Souriane, j'aimerais donc utiliser votre macro car elle pousse bien plus loin que ce que je sais faire.

J'aimerais que la macro balise les modifications afin de voir le travail qu'elle effectue.

Par exemple il me faudrait pouvoir apprécier les besoins de réglage pour le français FR ainsi que le résultat pour le type de texte que je relis.

Merci par avance de me mettre sur une piste !

[lgop2023]

Bonjour Souriane !

J'ai testé avec beaucoup d'intérêt la macro de mise en forme des dates avec les espaces insécables.

J'y vois deux limites :
- j'ai l'impression que la macro ne prend en compte que les dates avec les jours à 2 chiffres : le 8 décembre 1965 n'est pas traité.
- la macro ne travaille pas sur les notes de bas de page.

Comment faire (surtout pour le 2e point) ? (le premier, je pense que je peux y arriver tout seul)

Merci +++ !

Eric.

Bonjour Marielabeille!

J'ai plusieurs petits codes qui servent à faire des parties de ce que tu souhaites. Voilà, je te les partage. Attention, ils sont adaptés pour le Canada-Français (exemple : un espace insécable avant et après le deux-points).

Tout d'abord, quand je fais des "chercher/remplacer", je fais toujours appel à cette macro pour m'assurer que la fenêtre de C/R est "vide".

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
Sub Clear_ChercherRemplacer()
'Macro appelée au début et à la fin de d'autres macros pour remettre
'le rechercher remplacer à zéro
 
    With Selection.Find
        .ClearFormatting
        .Text = ""
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .MatchAllWordForms = False
        .MatchCase = False
        .MatchSoundsLike = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .Wrap = wdFindContinue
        .Forward = True
        .Format = False
    End With
 
End Sub

Celui-ci gère l'espace insécable dans les dates en français ET en anglais, ainsi que l'exposant du premier jour du mois (1er janvier 2014).

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
Sub G_Espace_Insecable_Mois_ANG_FRA()
 
'Macro qui gère l'espace insécable dans les dates
 
On Error GoTo Fin
Clear_ChercherRemplacer
 
Selection.HomeKey Unit:=wdStory
 
'(Macro créée par Sépia de Développez)
 
    Dim aTable(1 To 24) As String
    Dim ai As Byte
    Dim oRng As Range
 
    aTable(1) = "janvier"
    aTable(2) = "février"
    aTable(3) = "mars"
    aTable(4) = "avril"
    aTable(5) = "mai"
    aTable(6) = "juin"
    aTable(7) = "juillet"
    aTable(8) = "août"
    aTable(9) = "septembre"
    aTable(10) = "octobre"
    aTable(11) = "novembre"
    aTable(12) = "décembre"
    aTable(13) = "January"
    aTable(14) = "February"
    aTable(15) = "March"
    aTable(16) = "April"
    aTable(17) = "May"
    aTable(18) = "June"
    aTable(19) = "July"
    aTable(20) = "August"
    aTable(21) = "September"
    aTable(22) = "October"
    aTable(23) = "November"
    aTable(24) = "December"
 
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    '// Traitement de l'espace devant pour le français
    For ai = 1 To 12
        With Selection.Find
            .Text = "([0-9])([0-9]) (" + aTable(ai) + ")"
            .Replacement.Text = "\1\2^s\3"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
    '// Traitement de l'espace devant pour le français dans le cas du "1er" du mois
    For ai = 1 To 12
        With Selection.Find
            .Text = "(1er) (" + aTable(ai) + ")"
            .Replacement.Text = "\1^s\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
 
    '// Traitement de l'espace derrière pour le français
    For ai = 1 To 12
        With Selection.Find
            .Text = "(" + aTable(ai) + ") ([0-9])"
            .Replacement.Text = "\1^s\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
 
    '// Traitement de l'espace derrière pour l'anglais
    For ai = 13 To 24
        With Selection.Find
            .Text = "(" + aTable(ai) + ") ([0-9])"
            .Replacement.Text = "\1^s\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next
 
'Traitement de l'exposant dans une date du premier du mois (ex. 1er janvier)
 
 Clear_ChercherRemplacer
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
 
    With Selection
        .HomeKey Unit:=wdStory
        With .Find
            .ClearFormatting
            .Forward = True
            .Text = "1er "
            .Execute
            While .Found
                Set oRng = ActiveDocument.Range _
                (Start:=Selection.Range.Start + 1, _
                  End:=Selection.Range.End - 1)
                oRng.Font.Superscript = True
                oRng.Start = oRng.End
                .Execute
            Wend
        End With
    End With
 
'Nettoyer la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
Fin:
End Sub

Celle-ci gère la ponctuation (espaces insecable, espace avant le :, le ?, le !, etc.)

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
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
Sub G_Espace_Insecable_et_Ponctuation()
 
'Macro qui gère la ponctuation (espaces insecable, espace avant le :, le ?, le !, etc.)
 
'Nettoyer la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
On Error GoTo Fin
 
Selection.HomeKey Unit:=wdStory
 
'Espace insécable dans les format de nombre de 1 000 et plus
With Selection.Find
.Text = "(<[0-9]{2}) ([0-9]{3})"
.Replacement.Text = "\1^s\2"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = "(<[0-9]{3}) ([0-9]{3})"
.Replacement.Text = "\1^s\2"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = "(<[0-9]{1}) ([0-9]{3})"
.Replacement.Text = "\1^s\2"
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'____________________________
'Mise en forme du DEUX-POINTS
'Cherche tous les ":" et les remplace par "espace:espace"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
 
With Selection.Find
        .Text = ":"
        .Replacement.Text = " : "
        .Forward = True
        .MatchWildcards = False
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace:espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w:^w"
        .Replacement.Text = "^s: "
        .Forward = True
        .Wrap = wdFindContinue
End With
 
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = ":^w^p"
        .Replacement.Text = ":^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève les espaces dans l'heure en anglais
'
With Selection.Find
        .Text = ":"
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'____________________________
'Mise en forme du POURCENTAGE
'Cherche tous les "%" et les remplace par "espace insécable%espace"
With Selection.Find
        .Text = "%"
        .Replacement.Text = " % "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace%espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w%^w"
        .Replacement.Text = "^s% "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "%^w^p"
        .Replacement.Text = "%^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'
'Mise en forme du Dollar
'Cherche tous les "$" et les remplace par "espace insécable$espace"
With Selection.Find
        .Text = "([0-9])\$"
        .Replacement.Text = "\1^s$"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "Espace-$" et les remplace par "espace insécable$"
With Selection.Find
        .Text = "([0-9]) \$"
        .Replacement.Text = "\1^s$"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "$^w^p"
        .Replacement.Text = "$^p"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
 
'____________________________
'Mise en forme du Point d'interrogation
'Cherche tous les "?" et les remplace par "espace insécable?espace"
With Selection.Find
        .Text = "?"
        .Replacement.Text = " ? "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace?espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w?^w"
        .Replacement.Text = "^s? "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "?^w^p"
        .Replacement.Text = "?^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'____________________________
'Mise en forme du Point d'exclammation
'Cherche tous les "!" et les remplace par "espace insécable!espace"
With Selection.Find
        .Text = "!"
        .Replacement.Text = " ! "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Cherche tous les "espace-espace!espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w!^w"
        .Replacement.Text = "^s! "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'Enlève l'espace qui peut s'être créé avant un retour
With Selection.Find
        .Text = "!^w^p"
        .Replacement.Text = "!^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'____________________________
'Mise en forme du Point virgule
 
'Cherche tous les "espace-espace;espace-espace" et les remplace par la bonne forme
 
With Selection.Find
        .Text = "^w;^p"
        .Replacement.Text = ";^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
With Selection.Find
        .Text = "^w;^w"
        .Replacement.Text = "; "
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
        .Text = "; ^p"
        .Replacement.Text = ";^p"
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
'_________________________________
'Mise en forme des apostrophes
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "'"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "'"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "`"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "´"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
'_________________________________
'Mise en forme du signe du degré
 
    With Selection.Find
        .Text = "º"
        .Replacement.Text = "°"
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
'_________________________________
'Mise en forme du "h" de l'heure
 
With Selection.Find
        .Text = "^wh^w"
        .Replacement.Text = "^sh^s"
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
With Selection.Find
        .Text = "^wh."
        .Replacement.Text = "^sh."
        .MatchWildcards = False
        .Forward = True
        .Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
 
With Selection.Find
        .Text = "([0-9])h([0-9])"
        .Replacement.Text = "\1^sh^s\2"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
        .Text = "([0-9])h,"
        .Replacement.Text = "\1^sh,"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
        .Text = "([0-9])h."
        .Replacement.Text = "\1^sh."
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
 
With Selection.Find
        .Text = "^wh,"
        .Replacement.Text = "^sh,"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
 
'Autre
 
 
With Selection.Find
.Text = "( "
.Replacement.Text = "("
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = " )"
.Replacement.Text = ")"
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = " ,"
.Replacement.Text = ","
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
With Selection.Find
.Text = " ."
.Replacement.Text = "."
.Forward = True
.Wrap = wdFindContinue
End With
Selection.Find.Execute Replace:=wdReplaceAll
 
Selection.HomeKey Unit:=wdStory
  Do
    Selection.Find.ClearFormatting
    Selection.Find.Text = "\"
    Selection.Find.Execute
    If Selection.Find.Found = False Then
'rien
    Else
 
Selection.HomeKey Unit:=wdLine
    Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^~"
        .Replacement.Text = "-"
        .Forward = True
        .Wrap = wdFindStop
 
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
    With Selection.Find
        .Text = "^s: "
        .Replacement.Text = ":"
        .Forward = True
        .Wrap = wdFindStop
 
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
 
    With Selection.Find
        .Text = "^s"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindStop
 
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
 
 
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.Find.Text = "\"
    Selection.Find.Execute
 
  Loop While Selection.Find.Found = True
 
'Nettoyer la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
 
Fin:
End Sub

Celle-ci enlève tous les espaces en trop. Par exemple, des espaces avant un retour de ligne, ou encore un espace après l'ouverture d'une parenthèse, etc. Elle duplique certaine tâche déjà fait par les macros ci-dessous mais elle est bien utile quand même. Attention, il faut que ton document ait été fait selon "les règles de l'art". Par exemple, il faut avoir utilisé la touche de tabulation et non avoir insérer une dizaine d'espace pour faire une tabulation.

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
Sub GC_Ponctuation()
'
'
' Macro enregistrée le 2009-06-19 par Guylaine Constant
'
ActiveDocument.Content.Find.Execute _
    FindText:=".  ", _
    ReplaceWith:=". ", _
Replace:=wdReplaceAll
 
ActiveDocument.Content.Find.Execute FindText:="^w.", ReplaceWith:=".", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w^p", ReplaceWith:="^p", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=":", ReplaceWith:="^s:", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w:", ReplaceWith:="^s:", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  (", ReplaceWith:=" (", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=")  ", ReplaceWith:=") ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="(^w", ReplaceWith:="(", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w)", ReplaceWith:=")", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w,", ReplaceWith:=",", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=",", ReplaceWith:=", ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=",  ", ReplaceWith:=", ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w!", ReplaceWith:="!", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w;", ReplaceWith:=";", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=";  ", ReplaceWith:="; ", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="ect.", ReplaceWith:="etc.", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="etc…", ReplaceWith:="etc.", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^0171", ReplaceWith:="^0171^s", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^0171  ", ReplaceWith:="^0171^s", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^0187", ReplaceWith:="^s^0187", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  ^0187", ReplaceWith:="^s^0187", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w'", ReplaceWith:="'", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="%", ReplaceWith:="^s%", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  %", ReplaceWith:="^s%", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^w?", ReplaceWith:="?", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="$", ReplaceWith:="^s$", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="  $", ReplaceWith:="^s$", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:=" jour", ReplaceWith:="^sjour", Replace:=wdReplaceAll
 
 
'Vider la fenêtre de rechecher/remplacer via l'appel d'une macro:
Clear_ChercherRemplacer
 
End Sub

N'oublie pas, ce n'est pas parce que des macros font le boulot à notre place qu'il ne faut pas se revérifier. Comme par exemple, la dernière macro, dans le cas d'un chemin de réseau (ex: c:\test) va modifier le chemin pour "c : \test" Donc il faut se réviser et adapter la macro à sa propre situation

J'espère que ces codes te seront utiles.

Bonne chance!

Souriane