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

- 30 déc. 2012 à 02:54 - Dernière réponse :  Utilisateur anonyme
- 31 déc. 2012 à 03:15
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.
Afficher la suite 

Votre réponse

5 réponses

Meilleure réponse
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
- 30 déc. 2012 à 17:54
3
Merci
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)

Merci cs_Jack 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 88 internautes ce mois-ci

Commenter la réponse de cs_Jack
Meilleure réponse
Messages postés
14010
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
- 30 déc. 2012 à 17:58
3
Merci
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

Merci cs_Jack 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 88 internautes ce mois-ci

Commenter la réponse de cs_Jack
- 30 déc. 2012 à 03:20
0
Merci
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.
Commenter la réponse de Utilisateur anonyme
0
Merci
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.
Commenter la réponse de Akssion
- 31 déc. 2012 à 03:15
0
Merci
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).
Commenter la réponse de Utilisateur anonyme

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.