Discussion :

[yberard]

Bonjour à tous,

Je suis nouveau ici et cela fait à peine une semaine que j'ai débuté à faire des macro VBA sur word dans le cadre d'un stage.
Je m'excuses donc par avance si je dit de grosses bêtises ou si je ne comprends pas bien tout.

Voila mon problème:

Je dois créer un macro qui corrige directement des mots ou des phrases dans un document word. Ces mots ou ces phrases étant toujours les mêmes j'ai donc pu le faire à l'aide de "Sélectionner/remplacer". Cependant à un moment j'ai dû effectuer la recherche en fonction d'un mot variable mais toujours positionné à une position spécifique. J'ai donc réussi à rechercher ce mot que je doit alors corriger en fonction de cinq mots possible. J'ai d'ailleurs créé un Userform pour cela.

Mon code de recherche

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
 Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<liseré> <(*)>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    While Selection.Find.Found
        aMotTrouve = Selection.Range.Words(2)
        If ((Not ("violet " = aMotTrouve)) And (Not ("rouge " = aMotTrouve)) And (Not ("orange " = aMotTrouve)) And (Not ("vert " = aMotTrouve)) And (Not ("bleu " = aMotTrouve))) Then MsgBox aMotTrouve, vbCritical, "Erreur couleur liseré"
        If ((Not ("violet " = aMotTrouve)) And (Not ("rouge " = aMotTrouve)) And (Not ("orange " = aMotTrouve)) And (Not ("vert " = aMotTrouve)) And (Not ("bleu " = aMotTrouve))) Then Correc_couleur.Show
Selection.Find.Execute
       Wend

Avec le code pour le UseForm "Correc_couleur " qui est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Corriger_Click()
With Selection.Find
    .Text = Fenetre_EDD.aMotTrouve
    .Replacement.Text = Correc_couleur.Liste_couleur.Value
    .Forward = True
    .ClearFormatting
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
End With
Selection.Find.Execute
Unload Me  ' Ferme le UserForm
 
End Sub

Le problème, c'est que quand j'effectue cette macro, elle me propose de corriger le premier mot qui à un problème d'orthographe mais pas les suivants si il y en a ...
J'ai l'impression que c'est un problème lié au Select.Find mais je n'en suis pas sûr et j'ai essayé plusieurs choses sans succès

Pouvez vous m'aidez s'il vous plaît. J'espère avoir été suffisamment clair.

[yberard]

Bonjour à tous!

J'ai trouvé une solution "moyenne" pour pallier à mon problème mais je pense quand même qu'il y a mieux à faire ...
J'ai créé une boucle for avant mon code pour qu'il le répète un certain nombre de fois:

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
Dim i As Integer
i = 1
 
For i = 1 To 10
 Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<liseré> <(*)>"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    While Selection.Find.Found
        aMotTrouve = Selection.Range.Words(2)
        If ((Not ("violet " = aMotTrouve)) And (Not ("rouge " = aMotTrouve)) And (Not ("orange " = aMotTrouve)) And (Not ("vert " = aMotTrouve)) And (Not ("bleu " = aMotTrouve))) Then MsgBox aMotTrouve, vbCritical, "Erreur couleur liseré"
        If ((Not ("violet " = aMotTrouve)) And (Not ("rouge " = aMotTrouve)) And (Not ("orange " = aMotTrouve)) And (Not ("vert " = aMotTrouve)) And (Not ("bleu " = aMotTrouve))) Then Correc_couleur.Show
 
    'Selection.Find.ClearFormatting
    'With Selection.Find
     '   .Text = "<liseré> <(*)>"
     '   .Forward = True
     '   .Wrap = wdFindContinue
     '   .Format = False
     '   .MatchCase = False
     '   .MatchWholeWord = False
     '   .MatchAllWordForms = False
     '   .MatchSoundsLike = False
     '   .MatchWildcards = True
  '  End With
 
        Selection.Find.Execute
       Wend
Next i

Le problème de cela est que si il y a plus d'erreurs que le nombres de fois où je répète la boucle alors la macro ne corrigera pas toute les erreurs, mais si je mets un nombre trop important de répétition de la boucle, le macro plante ...
Cependant je n'ai pas trouvé de meilleur solution que celle ci pour l'instant

Help please

[Invité]

Bonjour,

Sans la méthode Find mais en testant la présence des chaînes dans chaque paragraphe :

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
 
Sub VerificationCouleursLisere()
 
Dim DocEnCours As Document
Dim I As Integer, J As Integer
Dim MesCouleurs As Variant
Dim MotTrouve As Boolean
 
    MesCouleurs = Array("violet", "rouge", "orange", "vert", "bleu")
    Set DocEnCours = ActiveDocument
 
    With DocEnCours
         For I = 1 To .Paragraphs.Count
             If InStr(1, .Paragraphs(I).Range.Text, "<liseré> <(*)>", vbTextCompare) > 0 Then
                MotTrouve = False
                For J = LBound(MesCouleurs) To UBound(MesCouleurs)
                    If InStr(1, .Paragraphs(I).Range.Text, MesCouleurs(J), vbTextCompare) > 0 Then MotTrouve = True
                Next J
                If MotTrouve = False Then
                   MsgBox "Erreur couleur liseré au paragraphe " & I
                   ' Suite du programme
                End If
             End If
         Next I
    End With
    Set DocEnCours = Nothing
 
End Sub