[VBA Word] Extraire toutes les chaînes d'une couleur dans un nouveau document [Résolu]

[3dfroggy]

Bonjour,

Je viens de consulter les archives et je ne pense pas que cette question ait déjà été posée.

Mon problème est simple : j'ai un document qui contient des chaînes de caractères en rouge et je cherche à extraire toutes ces chaînes en rouge dans un nouveau document.

J'ai pensé à deux méthodes :

1) Je recherche toutes les chaînes en rouge, je le copie et je les colle dans un nouveau document. Voici le code que j'obtiens :

Code :

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
 
Sub CopierTexteRougeNouveauDocument()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Font.Color = wdColorRed
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
End With
Do While Selection.Find.Execute
Selection.StartOf Unit:=wdWord
Selection.MoveEnd Unit:=wdWord
sBigString = sBigString + Selection.Text
Selection.MoveStart Unit:=wdWord
Loop
Documents.Add DocumentType:=wdNewBlankDocument
Selection.InsertAfter (sBigString)
End Sub

Deux problèmes :

1) Ce code m'extrait bien le texte en rouge mais quand ce texte est dans un tableau, il prend aussi ce qui précède dans la cellule (par exemple, pour le fichier joint, il m'extrait "6000 heures" alors que "6000" n'est pas en rouge).

J'ai bien pensé à inclure dans la macro du code qui recherche tous les tableaux et les convertisse en texte séparé par une tabulation mais je pense qu'il y a un autre moyen.

2) Ce code ne m'extrait pas le texte des zones de texte.

Quelqu'un aurait-il une idée ? Il n'y a aucune urgence.

Sinon, j'avais pensé à une autre méthode : rechercher toutes les chaînes "non rouges" et les remplacer par rien mais je ne sais pas comment exprimer "non rouge" en VBA (pour Word 2003).

Merci beaucoup de votre aide.

Bien cordialement,

Lionel

[Sepia]

Salut,

En fait c'est ta méthode de sélection qui ne correspond pas à tes besoins. Dans ta macro, tu recherches du texte en rouge en fait n'importe quel caractère, tu te déplaces en début puis tu sélectionnes le mot. Or dans ton tableau, l'espace entre 6000 hours est en rouge, donc il le trouve, se déplace vers le 1er mot donc 6000, et étend sa sélection vers le mot.

Pour résoudre ton problème
1°) Tu dois préciser mieux ta recherche, ce qui t'éviteras de trouver les 3 paragraphes vides de ton texte qui sont aussi en rouge, surtout si tu n'en as pas besoin (ce qui semble cas) en indiquant que tu désires rechercher les mots (et pas n'importe quel caractère) par

Code :

1
2
3
4
 
   Selection.Find.ClearFormatting
   With Selection.Find
      .Text = "<?"

mais tu ne récupères plus alors les retours chariots de ton texte. Mais comme je sais pas ce que tu veux comme résultat, je ne peux pas savoir si c'est bien ce qu'il te faut ou non. Un exemple du résultat attendu à partir de fichier source m'aurait permis de le savoir.

2°) lorsque tu as trouvé, tu te déplaces non pas d'un mot mais d'un seul caractère ==>

Code :

1
2
    Do While Selection.Find.Execute
        Selection.StartOf Unit:=wdCharacter

le reste est inchangé et fonctionne bien.

@+

[ouskel'n'or]

Ainsi, ça fonctionne

Code :

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 CopierTexteRougeNewDoc()
    With Selection
        .HomeKey Unit:=wdStory
        .Find.ClearFormatting
        With .Find
            .Text = "*"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindAsk
            .Font.Color = wdColorRed
            .Format = True
        End With
    End With
    With Selection
        Do While .Find.Execute
            With Selection
                .ExtendMode = True
                .MoveRight Unit:=wdWord, Count:=1
                sBigString = sBigString & Selection.Text
                .ExtendMode = False
            End With
            .MoveRight Unit:=wdWord, Count:=1, Extend:=wdMove
        Loop
    End With
    MsgBox sBigString
'Documents.Add DocumentType:=wdNewBlankDocument
'Selection.InsertAfter (sBigString)
End Sub

Bonne nuit

NB - Les arguments par défaut introduits par l'enregistreur de macro sont inutiles

[3dfroggy]

Bonjour,

Merci beaucoup de ton aide. Je me doutais bien que j'exposais mal le problème mais j'avais beau chercher, je ne voyais pas où.

Alors, pour préciser les choses :
1) Ce que je veux obtenir, c'est simplement un document contenant tous les mots (nombres ou chaînes alphanumériques) qui sont en rouge dans le document source. Je n'ai pas besoin des retours chariot ni des caractères spéciaux (accolades, crochets, etc.) mais s'ils y sont, ça ne me dérange pas.

2) L'objectif final, c'est de comptabiliser les mots (dans mon boulot, on comptabilise le travail en mots). Pour cela, j'utilise la commande Statistiques de Word. C'est pour ça que les caractères spéciaux n'ont pas d'importance, car ils sont ignorés par cette commande. Par contre, j'ai impérativement besoin d'un espace à la fin d'un seul mot, car si la macro concatène tout, le compte de mots sera faux.

3) Voici un exemple de ce que je souhaite obtenir :

Take off the chain coupling case and put good quality grease in it Refer to Recommended Oil List PB PF Series hours inside the tank Blank Page


Je viens d'intégrer tes corrections à mon code. Ca marchait très bien, sauf qu'un certain nombre de mots étaient concaténés. Du coup, j'ai ajouté un espace à l'aide du code :

Code :

1
2
 
sBigString = sBigString + Selection.Text + " "

Pour ceux que ça intéresse, le code final donne :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 
Sub CopierTexteRougeNouveauDocument()
Selection.Find.ClearFormatting
With Selection.Find
.Text = "<?"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Font.Color = wdColorRed
        .MatchWildcards = True
End With
Do While Selection.Find.Execute
Selection.StartOf Unit:=wdCharacter
Selection.MoveEnd Unit:=wdWord
sBigString = sBigString + Selection.Text + " "
Selection.MoveStart Unit:=wdWord
Loop
Documents.Add DocumentType:=wdNewBlankDocument
Selection.InsertAfter (sBigString)
End Sub

Merci beaucoup de ton aide. J'avais déjà bien galéré à trouver le bon caractères générique (et je m'étais planté !!!!) et à trouver les constantes de couleur, que je n'arrive pas à récupérer avec l'enregistreur de macros de Word 2003 (avec 2007, ça a l'air d'aller).

Cette macro va m'être bien utile.

Bien cordialement,

Lionel

PS : pour Ouskel'nor, je pense avoir allégé mon code et supprimé les arguments par défaut non pertinents ;-)

Envoyé par Sepia

Salut,

En fait c'est ta méthode de sélection qui ne correspond pas à tes besoins. Dans ta macro, tu recherches du texte en rouge en fait n'importe quel caractère, tu te déplaces en début puis tu sélectionnes le mot. Or dans ton tableau, l'espace entre 6000 hours est en rouge, donc il le trouve, se déplace vers le 1er mot donc 6000, et étend sa sélection vers le mot.

Pour résoudre ton problème
1°) Tu dois préciser mieux ta recherche, ce qui t'éviteras de trouver les 3 paragraphes vides de ton texte qui sont aussi en rouge, surtout si tu n'en as pas besoin (ce qui semble cas) en indiquant que tu désires rechercher les mots (et pas n'importe quel caractère) par

Code :

mais tu ne récupères plus alors les retours chariots de ton texte. Mais comme je sais pas ce que tu veux comme résultat, je ne peux pas savoir si c'est bien ce qu'il te faut ou non. Un exemple du résultat attendu à partir de fichier source m'aurait permis de le savoir.

2°) lorsque tu as trouvé, tu te déplaces non pas d'un mot mais d'un seul caractère ==>

Code :

le reste est inchangé et fonctionne bien.

@+

[Heureux-oli]

Petite précision, l'opérateur de concaténation n'est pas le + mais le &.

[3dfroggy]

Bonjour Ouskel'nor,

Merci beaucoup de ton aide. Par contre, le document que j'obtiens est vide (j'ai enlevé les apostrophes des deux dernières lignes, que tu avais mises en commentaire).

Mais bon, avec la réponse de Sepia, je suis comblé, donc pas la peine de chercher davantage pour moi.

J'ai tiré parti de tes commentaires et ai épuré mon nouveau code.

Merci encore.

Lionel

Envoyé par ouskel'n'or

Ainsi, ça fonctionne

Code :

Bonne nuit

NB - Les arguments par défaut introduits par l'enregistreur de macro sont inutiles