Surligner dans d'autres couleurs que celles proposées par Word ?

**bruxmu** · 14/07/2016, 09h48

Bonjour le forum,

J'anime chaque semaine une réunion qui rassemble une quinzaine d'interlocuteurs.
Pour ne louper aucun sujet, je surligne à la main le nom des interlocuteurs dans le compte rendu de la semaine précédente, ce qui me permet de retrouver en un coup d'œil, tous les sujets qui concernent un interlocuteur donné.
J'aimerais mener la même opération d'une macro qui fasse automatiquement le même type de surlignage.

J'ai donc besoin de couleurs nombreuses, variées et si possibles pas trop intenses.
Je ne trouve pas mon bonheur avec la palette que propose Word, où les couleurs sont peu nombreuses, flashy et/ou trop sombres.
Y a-t-il un moyen pour surligner dans d'autres couleurs que celles proposées par le système ?

Si ce n'est pas possible, j'ai bien pensé à ajouter une trame de fond aux textes que je veux surligner, parce que le choix de couleurs est plus étendu (même si les couleurs sont trop intenses à mon goût).
Problème pour moi qui suis nul en VBA : je sais créer une macro qui surligne un texte donné en employant la fonction rechercher/remplacer, en revanche je ne sais pas faire la même chose pour appliquer une trame de fond.

Merci à qui pourra m'aider !

**78chris** · 14/07/2016, 15h50

Bonjour

Par macro tu peux utiliser diverses méthodes mais comme tu évoques le chercher/remplacer en voici une :

Tu crées un style caractères pour chacun des noms (pour simplifier à l'identique du nom ici) dans le modèle qui te sert pour le CR
Nom : Styles_caractères.png
Affichages : 3125
Taille : 87,5 Ko

Nom : Styles_caractères.png
Affichages : 3125
Taille : 87,5 Ko

Puis une macro utilises ces styles en chercher/remplacer

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
Sub coloration()
'
'
Dim mesnoms(3)
mesnoms(1) = "titi"
mesnoms(2) = "toto"
mesnoms(3) = "tutu"
 
On Error GoTo Fin:
Application.DisplayAlerts = False
Selection.WholeStory
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        For i = 1 To UBound(mesnoms)
            .Replacement.Style = ActiveDocument.Styles(mesnoms(i))
            .Text = mesnoms(i)
            .Replacement.Text = mesnoms(i)
            .Execute Replace:=wdReplaceAll
        Next i
        .ClearFormatting
        .Replacement.ClearFormatting
    End With
Fin:
Application.DisplayAlerts = True
End Sub

Edit : gestion d'erreur partielle ajoutée au code

**bruxmu** · 14/07/2016, 22h13

Bonjour,

Merci pour ta réponse, qui est futée...mais qui me convient mal : mon CR est déjà écrit avec des styles.
Si je devais créer un style par interlocuteur, ça serait ingérable...
Je préférerais une autre astuce.

**78chris** · 15/07/2016, 00h29

RE

Ce sont des styles de caractères qui ne changent pas le style de paragraphe utilisé et le changement est fait par macro...
Quinze styles c'est 15 minutes une fois pour toutes dans le modèle et tu peux modifier les couleurs associées aux styles sans toucher au code et sans connaître leur code...

Sinon il faut une boucle par interlocuteur/couleur pour colorer le fond de chaque occurrence recherchée une par une du début à la fin.
Si le document est long cela peut prendre du temps...

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
Sub coloration2()
 
Dim mesnoms(5, 2) 'nom et teinte associée
mesnoms(1, 1) = "titi"
mesnoms(2, 1) = "toto"
mesnoms(3, 1) = "tutu"
mesnoms(4, 1) = "tata"
mesnoms(5, 1) = "tete"
mesnoms(1, 2) = 16774097
mesnoms(2, 2) = 14876613
mesnoms(3, 2) = 16773119
mesnoms(4, 2) = 16765393
mesnoms(5, 2) = 15204351
 
Application.ScreenUpdating = False
    Selection.Find.ClearFormatting
    With Selection.Find
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        For i = 1 To UBound(mesnoms)
            Selection.HomeKey Unit:=wdStory
            .Text = mesnoms(i, 1)
            While Selection.Find.Execute
                Selection.Shading.BackgroundPatternColor = mesnoms(i, 2)
            Wend
        Next i
    End With
    Selection.HomeKey Unit:=wdStory
End Sub

**bruxmu** · 15/07/2016, 14h52

Bonjour,

J'ignorais cette différence entre styles de caractères et styles de paragraphes.
En tous cas, ta macro marche parfaitement, c'est cool. Mille mercis !!!

Pour avoir l'occasion de te remercier une mille-et-unième fois :
y a-t-il un moyen de forcer à respecter la casse, car les noms que je veux surligner sont tjs écrits en majuscules, et certains d'entre eux peuvent se retrouver fortuitement à l'intérieur d'un mot écrit en minuscules ?