Discussion :

[cassnath]

Bonjour à tous,

J'ai environ 200 documents word à modifier. J'aimerai supprimer tous les mots surlignés en vert et bleu. Et lorsqu'un mot est surligné en jaune, word affiche le message à modifier. La macro suivante fonctionne :

Code :

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

1
2
3
4
5
6
7
8
9
Sub delete()
Dim wd
For Each wd In ActiveDocument.Words
wd.Select
If Selection.Range.HighlightColorIndex = wdYellow Then MsgBox "A modifier "
If Selection.Range.HighlightColorIndex = wdTurquoise Then Selection.Range.delete
If Selection.Range.HighlightColorIndex = wdBrightGreen Then Selection.Range.delete
Next wd
End Sub

Le problème est qu'à l'intérieur du document, il y a des logigrammes (zones de textes groupées). La macro me renvoie une erreur lorsqu'elle arrive sur la forme en question. Du texte surligné est également présent dans ces zones de texte. Mais je n'arrive pas à spécifier dans le code que word doit également tester les mots à l'intérieur des zones de texte.

Merci pour votre aide.
PS: je débute tout juste
En pièce jointe une exemple de document que je dois traiter

[Invité]

Bonjour,

Pas sûr que ce code traite tous vos cas :

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
 
Option Explicit
 
Sub TestDeleteTexteShape()
 
 Dim I As Integer
 Dim DocEncours As Document
 
    Set DocEncours = ActiveDocument
    With DocEncours
         For I = 1 To .Shapes(1).GroupItems.Count
             With .Shapes(1).GroupItems(I)
                  If .TextFrame.TextRange.Words.Count > 0 Then
                     DeleteTexteShape .TextFrame.TextRange
                  End If
             End With
         Next I
    End With
    Set DocEncours = Nothing
 
End Sub
 
 
Sub DeleteTexteShape(ByVal RangeATester As Range)
 
Dim J As Integer
 
    With RangeATester
         For J = .Words.Count To 1 Step -1
             With .Words(J)
                  Select Case .HighlightColorIndex
                         Case wdYellow
                              MsgBox "A modifier "
                         Case wdTurquoise
                              .delete
                         Case wdBrightGreen
                              .delete
                   End Select
            End With
        Next J
    End With
 
End Sub

[cassnath]

Merci beaucoup pour votre aide.

Le test est concluant sur les zones de texte.
Par contre, j'aimerai faire un seul programme pour tous les mots surlignés, qu'il soit dans le texte, dans le tableau ou dans les zones de texte. Dois-je insérer le code que j'avais déjà dans celui proposé?

Merci d'avance

[Invité]

Oui.

[cassnath]

Bonjour,

Je reviens vers vous. En testant le code sur mon document réel, j'ai un message d'erreur "ne peut s'appliquer qu'à un seul groupe". En effet les zones de textes groupées se trouve dans un tableau. De plus certaines zones de texte incluses dans le tableau ne sont pas groupées.

Je précise ma demande par rapport à mon premier message et vous joins un extrait du document réel.
La macro doit tester les mots contenus :
- dans le texte (paragraphe)
- dans le tableau
- dans une zone de texte incluse dans un tableau
- dans une zone de texte simple
- dans un ensemble de zones de texte groupées dans un tableau.

Je m'excuse de ne pas avoir été assez précise dans mon premier post.
Merci d'avance pour votre aide.

[Invité]

Pour tous les textes inclus dans des shapes, il vous faut vérifier le type de forme (cf énumération msoshapetype : https://docs.microsoft.com/fr-fr/off...e.msoshapetype).

Dans votre document, vous avez les trois types : 6, 17, 20. Selon, le type il vous faut accéder à différentes parties :

• Pour le type 20, boucler sur la collection CanvasItems
• Pour le type 17, récupérer le TextFrame.TextRange
• Pour le type 6, boucler sur la collection GroupItems

Pour la collection tables, prendre le range.

Par ailleurs, modifier la fonction pour éviter les mots "/" :

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
 
Sub DeleteTexteShape(ByVal RangeATester As Range)
 
Dim J As Integer
 
    With RangeATester
         For J = .Words.Count To 1 Step -1
             With .Words(J)
                  If .Text <> "/" Then
                        Select Case .HighlightColorIndex
                               Case wdYellow
                                    MsgBox .Text & " à modifier "
                               Case wdTurquoise
                                    .Delete
                               Case wdBrightGreen
                                    .Delete
                         End Select
                   End If
            End With
        Next J
    End With
 
End Sub

Pour les boucles, commencer par la fin car certains ranges disparaissent avec la fonction et l'indexation est perdue.

Attention dans votre tableau, le mot Badger ne constitue pas un mot car il est accolé avec Mettre.