Ecrire en rouge certains mots/ mélange de mots et chiffre

Bonjour,

J'ai des descriptifs produits dans une colonne excel, et il faut que certains mots deviennent rouges.

J'ai donc cette macro qui fonctionne pour des mots, mais dès que je mets des caractères composés de lettres et chiffres type "A122", ça ne marche pas. A terme, il faudra aussi que je puisse mettre en couleur des caractère du genre "2/220".

Pourtant, j'ai déclaré ma variable en string, qui devrait prendre en compte des chaines de caractère aussi bien de mots que de chiffres non ?

Voici mon programme :

Sub CharacterColor(AreaText, TextColoring, Optional RGBCode As Long = vbRed)

Dim Cel As Range, nbWord As Integer, tbl() As String, Start As Integer

TextColoring = LCase(TextColoring)

tbl = Split(TextColoring, ";")

For Each Cel In AreaText

For nbWord = 0 To UBound(tbl)

Start = InStr(LCase(Cel), tbl(nbWord))

Do While Start

Cel.Characters(Start, Len(tbl(nbWord))).Font.Color = RGBCode

Start = InStr(Start + 1, LCase(Cel), tbl(nbWord))

Loop

Next

Next

End Sub

Pour l'utilisation :

Sub TestCharacterColor()

Const SheetName As String = "Détails toutes refs" ' Nom de la feuille où se trouve les textes à mettre en forme

Const RangeAddress As String = "J1:J11000" ' Plage de cellules où se trouve les textes à mettre en forme (de la feuille SheetName)

Const WordList As String = "E1414" ' Liste des mots qui doivent être mis en évidence

Dim rng As Range

Set rng = ThisWorkbook.Worksheets(SheetName).Range(RangeAddress)

rng.Font.Color = 0 ' Efface la mise en forme précedente

CharacterColor rng, WordList ' Appel de la procédure qui souligne en rouge les mots des textes des cellules définies dans RangeAddress

End Sub

Je vous remercie d'avance

Bonjour,

j'ai testé ta macro, elle fonctionne avec des chiffres, des lettres et des caractères spéciaux.

la mise en forme partielle ne fonctionne pas sur des cellules contenant des formules

Effectivement elle marche, je ne le voyais juste pas,

Par contre deuxième question, j'ai presque 500 mots à tester de cette manière, et du coup ça me met erreur de capacité, est-ce que vous auriez une astuce pour que ça marche ?

En sachant que c'est des mots du genre A100, A101,A102... Je pourrais utiliser que les nombres et peut-être dire que si le nombre est compris entre tant et tant, il faut me les mettre en rouge, (et j'aurais plusieurs intervalles de cette manière), cela prendrait moins de place ?

Ou alors je fais plusieurs macro et je les lance l'une après l'autre ?

J'ai atteint la capacité de ligne maximale, donc je pensais refaire un

Const WordList As String = " ..." avec les mots qui me restent (une dizaine)

Mais il me met un message d'erreur comme quoi j'utilise déjà cette fonction sur la ligne du dessus. Finalement ce n'est pas la capacité du programme qui bloque mais juste que je ne peux plus écrire au bout de ma ligne. Comment puis-je faire ?

bonjour,

tu peux mettre ta liste de mots dans une feuille et l'exploiter dans ta macro

ta macro devient

Sub TestCharacterColor()
    Const SheetName As String = "sheet1"    ' Nom de la feuille où se trouve les textes à mettre en forme
    Const RangeAddress As String = "J1:J1000"    ' Plage de cellules où se trouve les textes à mettre en forme (de la feuille SheetName)
    Const listemots As String = "listemots" 'nom de la feuille où se trouvent les mots
    Const colonnemots As String = "A" 'nom de la colonne où se trouvent les mots
    With Sheets(listemots)
        dl = .Cells(Rows.Count, colonnemots).End(xlUp).Row 'ligne du dernier mot
        WordList = Application.Transpose(.Cells(1, colonnemots).Resize(dl))
        Dim rng As Range
        Set rng = ThisWorkbook.Worksheets(SheetName).Range(RangeAddress)
        rng.Font.Color = 0    ' Efface la mise en forme précedente
        CharacterColor rng, WordList
        ' Appel de la procédure qui souligne en rouge les mots des textes des cellules définies dans RangeAddress
    End With
End Sub

Sub CharacterColor(AreaText, TextColoring, Optional RGBCode As Long = vbRed)
    Dim Cel As Range, nbWord As Integer, tbl, Start As Integer
    tbl = TextColoring
    For Each Cel In AreaText
        For nbWord = LBound(tbl) To UBound(tbl)
            Start = InStr(LCase(Cel), LCase(tbl(nbWord)))
            Do While Start
                Cel.Characters(Start, Len(tbl(nbWord))).Font.Color = RGBCode
                Start = InStr(Start + 1, LCase(Cel), tbl(nbWord))
            Loop
        Next
    Next
End Sub