Sujet Précédent Sujet Suivant

[RESOLU] VBA Word : Remplacer trame de fond par surlignage

Résolu/Fermé
AlexCarret - Modifié le 16 mars 2020 à 11:20
 AlexCarret - 16 mars 2020 à 11:19
Bonjour, je requière votre aide pour régler un problème de trame de font.
Dans des fichiers word assez volumineux (50 pages mini) un collègue a eu la bonne idée de mettre une trame de fond (couleur d'arrière plan) au lieu du surlignage (car les couleurs de surli sont trop flash).
Sauf que cette trame de fond est très lourde à retirer (sélection exact du texte, si fin d'une phrase obligé de sélectionner moitié par moitié le texte surligné ...), pour un fichier standard qu'on doit remplir et où on doit enlever cette trame à chaque devis fait c’est une horreur.

Je cherche donc à remplacer la trame de fond par un surlignage.
L'outils rechercher/remplacé ne permet pas de travailler avec les trames de fond (ou pas trouvé). Je me suis donc attaqué au VBA, sans succès.

Voici un exemple de ce que j'ai pu tenté en VBA : 

Sub Surligne()
Dim wd
For Each wd In ActiveDocument.Words
If wd.Shading.BackgroundPatternColorIndex = wdYellow Then wd.Shading.BackgroundPatternColorIndex = none
' je dois également rajouter le surlignage, un truc du genre HighlightColorIndex = vbRed
Next wd
End Sub


J'ai essayé d'autres moyen de sélections à base de BackColor ou Selection.Find.Shading.BackgroundPatternColor =
mais je n'ai pas su les manier correctement :(

Auriez-vous une solution pour moi ? Merci :)
A voir également:

1 réponse

Réponse 1 / 1
AlexCarret
16 mars 2020 à 11:19
Je vais me faire incendier mais je viens de trouver une solution quelques minutes après avoir posté. Mais ça fait bien 2h que je cherche sur les forums ! J'ai attendu avant de poster.
J'ai trouvé cette solution sur un forum anglais que je ne citerai pour m'éviter tout problème ^^
(me dire si je peux poster le lien du topic de l'autre forum)

Voici la solution : 

Sub Surligner()
    Dim rg As Range
    Set rg = ActiveDocument.Range
    With rg.Find
        .Format = True
        .Text = ""
        .Font.Shading.BackgroundPatternColor = wdColorRed
        .Replacement.Text = ""
        While .Execute
            rg.Font.Shading.BackgroundPatternColor = wdColorAutomatic
            rg.HighlightColorIndex = wdYellow
            rg.Collapse wdCollapseEnd
        Wend
    End With
End Sub


Dans ce cas ça va rechercher le texte avec une trame de fond rouge, retirer la trame de fond puis mettre une surlignage jeune.
Après test ça marche également dans les tableaux si c'est bien un texte qui a la trame et pas toute la cellule.

En espérant que ça serve au moins à d'autres dans le futur ^^
1