Discussion :

[JukeBoX]

Bonjour,

Voilà le topo !

J'aimerai colorier en rouge une chaine de caractères qui débute par exemple par "NOUVEAU NOM" jusqu'à un retour chariot.

Exemple

ANCIEN NOM : DEVELOPPEZ
NOUVEAU NOM : DEVELOPPEZ.COM

Il faudrait colorier en rouge toute la ligne finalement jusqu'à un "vbCrLf"

Merci d'avance !

Edit : Si "NOUVEAU NOM : DEVELOPPEZ.COM" se trouve également dans une autre cellule, est-ce que cela serait plus simple à mettre en place ?

[JukeBoX]

J'ai trouvé ce code :

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
Public Sub ChgTxtColor()
    Set myRange = Range("A1:A100")  'The Range that contains the substring you want to change color
    substr = "delete"   'The text you want to change color
    txtColor = 3   'The ColorIndex which repsents the color you want to change
 
    For Each myString In myRange
        lenstr = Len(myString)
        lensubstr = Len(substr)
        For i = 1 To lenstr
            tempString = Mid(myString, i, lensubstr)
            If tempString = substr Then
                myString.Characters(Start:=i, Length:=lensubstr).Font.ColorIndex = txtColor
            End If
        Next i
    Next myString
End Sub

Mais celui ne fonctionne pas avec une valeur de cellule

Si je change :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

substr = "delete"

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

substr = Range("A1").Value

Cela ne fonctionne pas...

[Qwazerty]

Salut

Dans le code que tu fournis, SubStr contient la chaine qu'il faut passer en rouge. Cette chaine est recherchée dans les différents range.
Te concernant c'est un peu différent, il te faut adapter le code pour qu'arrivé à cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
myString.Characters(Start:=i, Length:=lensubstr).Font.ColorIndex = txtColor

i pointe le début de ta chaine "Nouveau Nom" et que
lenSubStr contienne le nombre de caractères entre le début de "Nouveau Nom" et le retour chariot.

Tu auras besoin, en plus des fonction déjà utilisées dans la code (Mid, Len,..) de la fonction InStr

Quelle est ta démarche, tu souhaites faire des essais toi même ?
Quoi que tu fasses (chercher par toi même ou demander un code), fait un retour, je te proposerai une solution.

++
Qwaz

[Qwazerty]

Un détail tout de même, le retour à la ligne est réalisé par un vbLf pas vbCrLF.

++
Qwaz

[JukeBoX]

Salut Qwazerty !

Merci pour tes messages, oui je parlais bien d'un retour chariot et non retour à la ligne.
Finalement j'ai contourné le problème en faisant autrement ^^

Merci tout de même à toi !

@+ et bon dimanche !

[Qwazerty]

Salut

Je te remercie pour ce retour.
Je dépose tout de même ici le code que j'avais préparé.

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
37
38
39
40
41
42
43
44
45
46
47
Option Explicit
 
Sub essaiMiseEnRouge()
Dim unePlage As Range
Dim Retour As Long
 
'A adapter
Const ChaineDepart As String = "Nouveau Nom"
Const CouleurRouge As Long = 3
    'On défnie la zone qui devra être traitée
    Set unePlage = Feuil1.Range("C17:C20")
 
    'On appelle la fonction de mise en Rouge
    Retour = MiseEnRouge(unePlage, ChaineDepart, CouleurRouge)
 
    'On informe du nombre de modification
    MsgBox "Il y a eu " & CStr(Retour) & " modification" & IIf(Retour > 1, "s.", "."), Title:="Compte Rendu"
End Sub
 
Function MiseEnRouge(Plage As Range, ChaineDepart As String, uneCouleur As Long) As Long
Dim aCell As Range
Dim iDepart As Integer, lenRouge As Integer
 
    'On boucle sur la plage
    For Each aCell In Plage
        'On s'assure que la cellule est du bon format (qu'elle contient "NouveauNom")
        'Ici on met vbTextCompare pour ne pas tenir compte de la casse (majuscul/minuscul)
        iDepart = InStr(1, aCell.Value, ChaineDepart, vbTextCompare)
        If iDepart > 0 Then
            'On détermine la longueur de la chaine qui devra passer en rouge
            lenRouge = InStr(iDepart, aCell.Value, vbLf) - iDepart + 1
            'On vérifie que le retour à la ligne à été trouvé
            If lenRouge <= 0 Then
                'Nom trouvé, on prend la fin de la chaine
                lenRouge = Len(aCell.Value) - iDepart + 1
            End If
            'On reteste (après une éventuelle modification à la ligne précédente
            If lenRouge > 0 Then
                'On passe la chaine en rouge
                aCell.Characters(iDepart, lenRouge).Font.ColorIndex = uneCouleur
                'On incrémente le retour
                MiseEnRouge = MiseEnRouge + 1
            End If
        End If
    Next
 
End Function

++
Qwaz