Macro Word "comparaison-remplacement" (niveau "difficile")Résolu

Question

Bonjour,

Ne connaissant rien de la programmation des macros mais impressionné par les réponses aux questions les plus audacieuses, je propose à la "communauté" cette difficile requête :

- dans un fichier A (Word), j'ai un long texte dont les mots n'ont pas de police particulière (c'est à dire pas de soulignement, de gras, d'italique ou de surlignage).

- dans un fichier B (Word aussi), j'ai une suite de mots qui ont la particularité d'avoir certaines de leurs lettres soulignées, en gras, en italique ou surlignées.

Je souhaiterais que les mots du fichier A qui sont dans la liste B prennent la même police que le mot de la liste B (c'est à dire le soulignement, le surlignage, etc.,  des lettres concernées).

Attention : seuls les mots strictement équivalents doivent être modifiés. Par exemple, si dans la liste B, il y le mot "opéra", celui-ci ne doit pas changer le début du mot "opération" ; il ne doit changer que les mots "opéra" du fichier A.

Merci et bonne année.

cs_Jack · Accepted Answer

Salut Cmarmotte : je pense malgré tout que cela est faisable sans trop de casse, puisqu'il ne souhaite que de reformater les mots (puisque les mots sont identiques). Sujet intéressant et un peu de temps : voilà mon test : Dans ce test, il y a 3 documents : - Celui avec la liste de mots formatés (Liste mots formatés.docx) - Celui à modifier (Test format.docx) - Celui hébergeant la macro - Il est fort déconseillé de mettre la macro dans le fichier à modifier. J'ai fait la macro sous Word 2010, mais fonctionnerait aussi sous versions 2003/2007. Partie déclarations : Option Explicit Private oDocListe As Document Private oDocTravail As Document Partie code (en dessous) Sub xxxx() Dim oRange As Range Dim oWord As Range Set oDocListe = Documents.Open("C:\Temp\Liste mots formatés.docx", ReadOnly:=True) Set oDocTravail = Documents.Open("C:\Temp\Test format.docx") ' Parcoure notre liste de mots formatés Set oRange = oDocListe.Range(Start:=0, End:=oDocListe.Characters.Count) For Each oWord In oRange.Words If (oWord.Text <> vbCr) And _ (oWord.Text <> vbNullString) Then Call ChercheEtFormate(oWord) End If Next oWord oDocListe.Close SaveChanges:=False oDocTravail.Close ' oDocTravail.Close SaveChanges:=True Debug.Print "Terminé" End Sub '------------------------------------------------- Sub ChercheEtFormate(ByVal TheMot As Range) Dim oRange As Range Dim oWord As Range Dim r As Long ' Parcoure notre document à modifier Set oRange = oDocTravail.Range(Start:=0, End:=oDocTravail.Characters.Count) Debug.Print oRange.Words.Count For Each oWord In oRange.Words If StrComp(Trim$(oWord.Text), Trim$(TheMot.Text), vbTextCompare) = 0 Then ' Mot identique trouvé ' Parcoure chaque lettre et applique le même format For r = 1 To TheMot.Characters.Count With oWord.Characters(r) .Font = TheMot.Characters(r).Font .Bold = TheMot.Characters(r).Bold .Underline = TheMot.Characters(r).Underline .Italic = TheMot.Characters(r).Italic End With Next r End If Next oWord End Sub Place le curseur dans la Sub xxxx et appuie sur F5 ou bien associe cette Sub à un bouton. Il faut juste se méfier d'une chose : le découpage en mot par Word inclut l'espace qui suit ce mot; d'où l'usage de Trim. Dans ce code, la comparaison des chaines se fait sans tenir compte de la casse (min/maj) Vala Jack, MVP VB NB : Je ne répondrai pas aux messages privés Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Utilisateur anonyme · Answer

Bonjour,


Ne connaissant rien de la programmation des macros


Et aussi ne connaissant visiblement rien du règlement qui gouverne ce lieu; lequel règlement qui dit que demandeur doit fournir une portion significative de son code qui va montrer la difficulté rencontrée.

Cet exemple, tiré de l'aide de VBA, passe tous les mots d'un texte pour effacer tous les franklin.

Set myRange = ActiveDocument.Range(Start:=0, End:=Selection.End)
For Each aWord In myRange.Words
    If aWord.Text = "Franklin " Then aWord.Delete
Next aWord

il te reste juste à remplacer

If aWord.Text = "Franklin " Then aWord.Delete

Par une boucle qui passer chaque mot lettre par lettre et qui va prendre note de chaque formatage particulier. Ensuite, tu vas devoir prendre ta liste de mots et ta liste de lettres formatées et les comparer à tous les mots de ton autre document. Et comme tes documents sont longs et que VBA n'est pas un langage compilé, cela va être long longtemps.

En d'autres termes, oublie ça.

cs_Jack · Answer

PS : Modifs

Sub ChercheEtFormate(ByRef TheMot As Range)
Ici, mieux vaut utiliser ByRef.
Je pensais avoir besoin de modifier la variable sans vouloir altérer la source, mais je ne touche pas au mot.

Le Debug.Print n'était là que pour surveiller ma sélection

Akssion · Answer

Bonsoir,

jack : ta réponse est excellente.
J'ai buté quelques temps sur un message d'erreur dû à un problème de déclaration de "oDocTravail" dans la seconde Sub. J'ai donc rajouté :
        Set oDocTravail = Documents("C:\Temp\Test format.docx")

Par ailleurs dans cette même Sub : .Font = TheMot.Characters(r).Font
 suffit à copier la forme du mot sans besoin de bold, Underline et Italic. En les supprimant, ça soulage le programme qui n'a pas à faire 2 fois la même chose.

Bref, que des détails par rapport à l'excellent code fourni qui fonctionne à merveille. Un très grand merci !!!

Bonne année à toi.

Utilisateur anonyme · Answer

Bonjour,

Loin de moi l'idée de partir une guerre, surtout que la solution de Jack convient aux besoins exprimés. Je n'avais pas saisi que la liste de mots était commune à l'ensemble des documents.

D'une manière plus générale et pour les gens qui seraient aux prises avec un problème semblable. Ma réaction de laisser tomber cette idée reposait en grande partie sur la quantité d'attributs de formatage supportés par Word. Pour la plupart des gens, tester gras, italique et souligné suffisent. Mais, il suffit d'enregistrer une simple macro pour formater un mot pour avoir une petite idée de l'ampleur de la tâche pour tester tous les formats possibles qui peuvent être appliqués à un texte.

Effectivement, Jack a prouvé que c'est possible pour un nombre restreint d'attributs connus. Ceci dit je suis toujours rébarbatif pour une quantité inconnue d'attributs inconnus dans le(s) texte(s).

Macro Word "comparaison-remplacement" (niveau "difficile")

5 réponses

Votre réponse

Discussions similaires