XL 2016 Mettre en couleur, en gras et souligner un mot d'une phrase dans une cellule

[Loic80]

Bonjour,

J'ai un tableau Excel et je souhaite mettre en couleur, en gras et souligner certains mots d'une cellule.
Je m'explique : je voudrai que lorsque j'écris le mot BORNE VERRE, celui-ci soit automatiquement en vert en gras et souligné sur les colonnes E à J, mais je ne sais pas comment faire j'ai cherché sur internet et sur les forums mais malheureusement je n'ai rien trouvé.
Je joins un extrait de mon tableau qui contient l'exemple de ce que je veux faire, je l'ai fait manuellement mais j'aimerai que ce soit automatique surtout parce que ces mots seront répétés sur chaque ligne ou presque, ce qui représente des centaines de lignes.
Je ne sais pas si c'est possible alors j'espère qu'un âme charitable pourra m'indiquer la marche à suivre.
Désolé je débute :/

Merci d'avance.

Cordialement,

 

[Nicolas JACQUIN]

Bonjour,
comme ça ?

 

[Loic80]

Bonjour,

Non je veux que seul les mots BORNE VERRE soient en vert, en gras et souligné et non pas tout le texte de la cellule.
Merci

 

[fanfan38]

Bonjour
Ci joint ma solution
A+ François

 

[Nicolas JACQUIN]

Voici, comme il faut en automatique, avec code si-dessous.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Set PlageTest = Range("E17:E150")
If Not Intersect(Target, PlageTest) Is Nothing Then
For Each Cell In PlageTest
    If Cell.Value Like "*BORNE VERRE*" Then
    With Cell.Characters(Start:=1, Length:=11).Font
        .FontStyle = "Gras"
        .Underline = xlUnderlineStyleSingle
        .ThemeColor = xlThemeColorAccent6
        .ColorIndex = 10
    End With
    End If
Next
End If
End Sub

 

[Loic80]

Merci a vous les deux macros fonctionnent très bien. Comment dois-je rentrer le code dans mon classeur ? Et si je veux étendre la macro à plus de lignes ou changer la couleur je n'ai juste qu'a la modifier c'est bien ca ?

 

[fanfan38]

tu dois copier les 2 macros qui sont dans le module 1 sur ton classeur
pour changer la couleur modifier une de ces 2 lignes
.ThemeColor = xlThemeColorAccent6 'ou
' .ColorIndex = 3 'rouge
l'autre étant précédé d'un ' (comme ici la 2ème ligne) n'est pas utilisée

Dans la seconde macro (action)
dl = Range("E" & Rows.Count).End(xlUp).Row 'calcul la dernière ligne
MotEnCouleur "BORNE VERRE", Range("E17:j" & dl) 'appel la macro précédente pour les cellules de E17 à J de la dernière ligne

A+ François

 

[Nicolas JACQUIN]

Pour ma part, suffit de modifier juste la plage si-dessous,
(pour reprendre ce que dit Fanfan38), actuellement de E17 à E150

Dim dl As Long
dl = Range("E" & Rows.Count).End(xlUp).Row
Set PlageTest = Range("E17:E" & dl)

soit
Code à mettre dans le code feuille

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dl As Long
If Target.Count > 1 Then Exit Sub
dl = Range("E" & Rows.Count).End(xlUp).Row
Set PlageTest = Range("E17:E" & dl)
If Not Intersect(Target, PlageTest) Is Nothing Then
For Each Cell In PlageTest
    If Cell.Value Like "*BORNE VERRE*" Then
    With Cell.Characters(Start:=1, Length:=11).Font
        .FontStyle = "Gras"
        .Underline = xlUnderlineStyleSingle
        .ThemeColor = xlThemeColorAccent6
        .ColorIndex = 10
    End With
    End If
Next
End If
End Sub

Voter si résolu

 

[Loic80]

Merci beaucoup vous m'avais vraiment aidé pour le coup. Merci encore.

 

[Loic80]

J'ai une autres petite question du coup j'ai voulu modifier des mots à changer et des couleur mais ça ne passe pas il me dise nom ambigu j'ai recopier le code en changeant le mot et la couleur :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Set PlageTest = Range("E17:E150")
If Not Intersect(Target, PlageTest) Is Nothing Then
For Each Cell In PlageTest
If Cell.Value Like "*BORNES PAPIERS*" Then
With Cell.Characters(Start:=1, Length:=14).Font
.FontStyle = "Gras"
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorAccent1
.ColorIndex = 10
End With
End If
Next
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Set PlageTest = Range("E17:E150")
If Not Intersect(Target, PlageTest) Is Nothing Then
For Each Cell In PlageTest
If Cell.Value Like "*BORNES EML*" Then
With Cell.Characters(Start:=1, Length:=10).Font
.FontStyle = "Gras"
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorAccent4
.ColorIndex = 10
End With
End If
Next
End If
End Sub

Je voulais pas tout vous demander des le départ e' pesant être lourd, je pensait y arriver en gardant le modèle et en modifiant juste ce que je voulais mais ça a l'air plus complexe en fait.

Merci de vos réponses.

 

[Nicolas JACQUIN]

Tu ne peux pas avoir de formules evenementiels identiques sur une même feuille, soit là 2 fois

Sub Worksheet_Change

 

[Nicolas JACQUIN]

Comme ça

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Set PlageTest = Range("E17:E150")
If Not Intersect(Target, PlageTest) Is Nothing Then
For Each Cell In PlageTest
If Cell.Value Like "*BORNES PAPIERS*" Then
With Cell.Characters(Start:=1, Length:=14).Font
.FontStyle = "Gras"
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorAccent1
.ColorIndex = 10
End With
End If
If Cell.Value Like "*BORNES EML*" Then
With Cell.Characters(Start:=1, Length:=10).Font
.FontStyle = "Gras"
.Underline = xlUnderlineStyleSingle
.ThemeColor = xlThemeColorAccent4
.ColorIndex = 10
End With
End If
Next
End If
End Sub

 

[Loic80]

Bonjour Nico J,

En fait je voudrais que lorsque j'écris :
"BORNES VERRE", il soit en vert gras et souligné
"BORNES PAPIERS", il soit en bleu gras et souligné
"BORNES EML", il soit en jaune gras et souligné

Je te joint le fichier avec le modèle de ce que j'ai fait manuellement.

Merci de tes réponses et du temps pris.

Loïc

 

[Loic80]

Et ils sont souvent dans la même cellules ces mots.
Merci.

 

[patricktoulon]

bonjour
voila un code que tu pourra agrémenter d'autre expressions dans le futur en faisant pareil que les précédente en rajoutant des "case" dans le select case

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x&, z&, A As Boolean
    If Target.Column = 5 And Target.Count = 1 Then
        If Target.Value <> "" Then
            Select Case True

            Case InStr(1, Target, "BORNES VERRE", vbTextCompare) > 0
                x = InStr(1, Target, "BORNES VERRE", vbTextCompare): z = 12: c = xlThemeColorAccent1: A = True

            Case InStr(1, Target, "BORNES PAPIERS", vbTextCompare) > 0
                x = InStr(1, Target, "BORNES PAPIERS", vbTextCompare): z = 14: c = xlThemeColorAccent6: A = True

            Case InStr(1, Target, "BORNES EML", vbTextCompare) > 0
                x = InStr(1, Target, "BORNES EML", vbTextCompare): z = 10: c = xlThemeColorAccent4: A = True

                'case etc.....

            Case Else: A = False
            End Select
            'on remet la cellule en normal
            With Target.Font: .Bold = False: .Underline = -4142: .Color = vbBlack: End With

            If A Then    'si oui on met l'expression au format
                With Target.Characters(Start:=x, Length:=z).Font
                    .FontStyle = "Gras"
                    .Underline = xlUnderlineStyleSingle
                    .ThemeColor = c
                    .ColorIndex = 10
                End With
            End If

        End If
    End If
End Sub