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

Loic80

XLDnaute Nouveau
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,
 

Pièces jointes

  • Classeur1.xlsx
    10.2 KB · Affichages: 27
Solution
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...

Nico_J

XLDnaute Junior
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
 

Pièces jointes

  • Classeur1TOP.xlsm
    15.9 KB · Affichages: 7

fanfan38

XLDnaute Barbatruc
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
 

Nico_J

XLDnaute Junior
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
 

Pièces jointes

  • Classeur1TOP.xlsm
    17.8 KB · Affichages: 3
Dernière édition:

Loic80

XLDnaute Nouveau
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.
 

Nico_J

XLDnaute Junior
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
 

Pièces jointes

  • Classeur1TOP.xlsm
    21.4 KB · Affichages: 7

Loic80

XLDnaute Nouveau
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
 

Pièces jointes

  • Classeur1.xlsx
    11.2 KB · Affichages: 7

patricktoulon

XLDnaute Barbatruc
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
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87