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

Loic80 · 12 Janvier 2021

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,

Loic80 · 14 Janvier 2021

Bonjour,

La macro fonctionne nickel. Merci job75 pour cette aide précieuse. Je cherchais depuis longtemps comment faire mais c'est du haut niveau et j'ai encore du boulot pour arriver à un résultat comme ça.
J'ai modifier le code pour qu'il commence à la première cellule et ça fonctionne.
Encore une fois merci, mon tableau sera plus lisible comme ça.

Loïc

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range, texte, couleur, i%, j%
Set r = Intersect(Target, Sh.Range("E1:E" & Sh.Rows.Count))
If r Is Nothing Then Exit Sub
texte = Array("BORNES VERRE", "BORNES PAPIERS", "BORNES EML", "BORNES OMR")
couleur = Array(RGB(84, 130, 53), RGB(47, 117, 181), RGB(191, 143, 0), RGB(64, 64, 64))
With r.Font...

Nicolas JACQUIN · 12 Janvier 2021

Bonjour,
comme ça ?

Loic80 · 12 Janvier 2021

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 · 12 Janvier 2021

Bonjour
Ci joint ma solution
A+ François

Nicolas JACQUIN · 12 Janvier 2021

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

VB:

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 · 12 Janvier 2021

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 · 12 Janvier 2021

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 · 12 Janvier 2021

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

VB:

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

VB:

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 · 12 Janvier 2021

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

Loic80 · 12 Janvier 2021

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 · 12 Janvier 2021

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

VB:

Sub Worksheet_Change

Nicolas JACQUIN · 12 Janvier 2021

Comme ça

Code:

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 · 13 Janvier 2021

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 · 13 Janvier 2021

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

patricktoulon · 13 Janvier 2021

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

VB:

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

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

Loic80

XLDnaute Nouveau

Pièces jointes

Loic80

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

Loic80

XLDnaute Nouveau

fanfan38

XLDnaute Barbatruc

Pièces jointes

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

Loic80

XLDnaute Nouveau

fanfan38

XLDnaute Barbatruc

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

Loic80

XLDnaute Nouveau

Loic80

XLDnaute Nouveau

Nicolas JACQUIN

XLDnaute Impliqué

Nicolas JACQUIN

XLDnaute Impliqué

Pièces jointes

Loic80

XLDnaute Nouveau

Pièces jointes

Loic80

XLDnaute Nouveau

patricktoulon

XLDnaute Barbatruc

Discussions similaires