Discussion :

[Souriane]

Bonjour!!

J'ai une liste de 10 phrases qui apparaît régulièrement dans mes documents et que je dois formater comme suit chaque fois :
-texte centré
-lettres tout en majuscules
-pas plus ni moins que 2 retours avant le texte et 3 après le texte.

J'ai travaillé avec de l'aide ci et là d'Internet. Mais je bloque pour les codes de retour. Il pourrait arriver qu'il y ait par exemple 4 retours devant et 1 après. Je dois donc enlever tous les :
[x nombre de retour avant]Mon Texte 0[x nombre de retours après]

Pourrait compliquer la chose, il peut arriver que la phrase soit par erreur précédée ou suivi d'un certain nombre d'espaces (^w) qu'il faut donc enlever avant de travailler le nombre de retour.

Voici mes macros et merci de votre aide!

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
sub MaMacro ()
 
Dim rText As Range
Dim vFindText(4) As Variant 
Dim i As Long
 
vFindText(0) = "Mon Texte 0"
vFindText(1) = "Mon Texte 1"
vFindText(2) = "Mon Texte 2"
vFindText(3) = "Mon Texte 3"
vFindText(4) = "Mon Texte 4"
'etc.
 
For i = 0 To UBound(vFindText)
    With Selection
        .HomeKey wdStory
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(findText:=vFindText(i), _
                MatchWildcards:=True, _
                Wrap:=wdFindStop, MatchCase:=False, Forward:=True) = True
                Set rText = Selection.Range 
                With rText 
                    Select Case i
                    Case Is = 0
                            Macro_Mise_en_forme
                    Case Is = 1
                            Macro_Mise_en_forme
                    Case Is = 2
                            Macro_Mise_en_forme
                    Case Is = 3
                            Macro_Mise_en_forme
                    Case Is = 4
                            Macro_Mise_en_forme
                    End Select
                End With
            Loop 
        End With
    End With
Next i
End Sub

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
Sub Macro_Mise_en_forme()
 
'Centre le texte
    With Selection.ParagraphFormat
        .Alignment = wdAlignParagraphCenter
    End With
 
'Enlève l'option "allcaps" s'il y a lieu
    With Selection.Font
        .AllCaps = False
    End With
 
'Met toutes les lettres en majuscules comme il se doit
    Selection.Range.Case = wdUpperCase
 
End Sub

[Sepia]

Salut Souriane,

Je ne vois pas où sont les remplacements et ton code est compliqué. Tu es sure d'avoir tout mis ta macro ?

Pour avancer, lorsque que tu es dans une telle situation, il faut d'abord traiter les cas d'erreurs pour se ramener à un document "propre" et lui appliquer la bonne macro.

Par exemple, pour les espaces avant ou après, commences par les supprimer avec (^w) comme tu l'indiques. Pour les retours avant et après, tu ne peux pas utiliser les caractères génériques (dans ton cas) donc tu dois faire une boucle pour éliminer les cas "[x nombre de retour avant]Mon Texte 0[x nombre de retours après]"

Pour que tu ne sois pas perdue, j'ai utilisé ta structure de macro (en la simplifiant)

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
Sub TaMacro()
 
    Dim rText As Range
    Dim vFindText(4) As Variant
    Dim aI As Long
 
    vFindText(0) = "Mon Texte 0"
    vFindText(1) = "Mon Texte 1"
    vFindText(2) = "Mon Texte 2"
    vFindText(3) = "Mon Texte 3"
    vFindText(4) = "Mon Texte 4"
    'etc.
 
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    For aI = LBound(vFindText) To UBound(vFindText)
        With Selection.Find
            .Text = "^p^w^p" + vFindText(aI)
            .Replacement.Text = "^p" + vFindText(aI)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Next
    For aI = LBound(vFindText) To UBound(vFindText)
        With Selection.Find
            .Text = vFindText(aI) + "^p^w^p"
            .Replacement.Text = vFindText(aI) + "^p"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Next
    For aI = LBound(vFindText) To UBound(vFindText)
        With Selection.Find
            .Text = "^p^p" + vFindText(aI)
            .Replacement.Text = "^p" + vFindText(aI)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Next
    For aI = LBound(vFindText) To UBound(vFindText)
        With Selection.Find
            .Text = vFindText(aI) + "^p^p"
            .Replacement.Text = vFindText(aI) + "^p"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Next
 
    '// Maintenant ton texte est du style "^pMon Texte 0^p" ==> on passe à "^p^pMon Texte 0^p^p^p"
    For aI = LBound(vFindText) To UBound(vFindText)
        With Selection.Find
            .Text = "^p" + vFindText(aI) + "^p"
            .Replacement.Text = "^p^&^p^p"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Next
 
 
    For aI = LBound(vFindText) To UBound(vFindText)
        Selection.HomeKey wdStory
        Do While Selection.Find.Execute(findText:="^p^p" + vFindText(aI) + "^p^p^p", MatchWildcards:=False, Wrap:=wdFindStop, MatchCase:=False, Forward:=True) = True
            'Centre le texte
            Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 
            'Enlève l'option "allcaps" s'il y a lieu
            Selection.Font.AllCaps = False
 
            'Met toutes les lettres en majuscules comme il se doit
            Selection.Range.Case = wdUpperCase
        Loop
    Next
End Sub

@+

[Heureux-oli]

Salut souriane,

Juste une fois, tu pourrais pas poser une question simple

Je ne connais ni les tenants ni les aboutissants.

C'est possible, mais ça va être une usine à gaz.

J'ai un morceau de code que je viens de tester.
Il cherche un morceau de texte, supprime les espaces avant et vérifie le paragraphe juste avant.

On peut tout faire en boucle pour supprimer tous les paragraphes pour ensuite ajouter le bon nombre.
A toi de voir si cette voie t'intéresse ou pas.

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
 
Sub RechercheDeTexte()
Dim stTxt As String
Dim intPara As Integer
 
 
 
stTxt = "Mon texte"
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
    .Text = stTxt
    .Forward = True
    .Execute
End With
Selection.Expand unit:=wdParagraph
Selection.Range.Text = LTrim(Selection.Range.Text)
 
Selection.HomeKey unit:=wdStory, Extend:=True
intPara = Selection.Paragraphs.Count + 1
 
Debug.Print intPara
If Len(ActiveDocument.Paragraphs(intPara - 1).Range.Text) = 1 Then
    ActiveDocument.Paragraphs(intPara - 1).Range.Delete
End If
 
End Sub

[Souriane]

Gros merci de la réponse!

Comme je travaille sur 56 projets en même temps, je n'avais pas eu le temps de revenir sur celui-ci. J'y travaille aujourd'hui.

Ça devrait fonctionner. En tout cas, je vois plus "clair" maintenant!

Gros gros merci de votre temps, c'est extrêmement apprécié!!