Un mot sur 2 de couleur différente dans une même cellule

[zeltron]

Bonjour à tout le forum,

Voici mon problème: je souhaiterais que les différents mots d'une cellule soit en couleur différente, le premier mot en noir le 2eme en rouge, le 3eme en noir , le 4eme en rouge ect...; en fait un mot sur 2 en rouge.

J'ai fait une recherche sur le forum, mais je n'ai pas trouvé de réponse à mon problème, je suis tombé sur un fil prposant de colorier les majuscule d'une cellule, mais le code ne m'a pas permis de me mettre sur une piste pour une solution.

Je pense que la solution ( peut être) passerait par le repérage des "blancs" dans la cellule afin de répérer les différents mots.

Je vous joint un fichier exemple afin que cela soit plus explicite.

Je vous remercie par avance

Cordialement

Zeltron

 

[Bernard_XLD]

Re : Un mot sur 2 de couleur différente dans une même cellule

Bonjour

rapide, voici un code pour modifier la cellule active

A+
Sub un_mot_sur_deux_en_rouge()
Dim Valcompteur() As Integer, Val_Cellule As String, Val As Integer, Compteur As Integer
Val = 0
Compteur = 0
Val_Cellule = ActiveCell.Text
Do
Compteur = InStr(Compteur + 1, Val_Cellule, " ", 1)
If Compteur > 0 Then
Val = Val + 1
ReDim Preserve Valcompteur(1 To Val)
Valcompteur(Val) = Compteur
End If
Loop Until Compteur = 0
If Val > 0 Then
For Compteur = 1 To Val Step 2
If Compteur = Val Then
ActiveCell.Characters(Start:=Valcompteur(Compteur) + 1, Length:=Len(valcellule) - _
Valcompteur(Compteur) + 1).Font.ColorIndex = 3
Else
ActiveCell.Characters(Start:=Valcompteur(Compteur) + 1, Length:=(Valcompteur(Compteur + 1) _
- 1) - Valcompteur(Compteur) + 1).Font.ColorIndex = 3
End If
Next Compteur
End If
End Sub

 

[Luki]

Re : Un mot sur 2 de couleur différente dans une même cellule

Bonjour,

Yeahou a été plus rapide!

Je te mets quand même le code que j'ai concocté qui traite la cellule active.

Sub Stendhal()
Dim Rg As Range
Dim Bolred As Boolean
Dim i%, ii%

    Set Rg = ActiveCell
    Bolred = False
    i = 1
    
    'traitement des mots jusqu'au dernier espace trouvé
    Do While InStr(i, Rg.Text, " ")
        ii = InStr(i, Rg.Text, " ")
            If Bolred = False Then
                Rg.Characters(i, ii - i).Font.ColorIndex = 3
                Bolred = True
            Else
                Rg.Characters(i, ii - i).Font.ColorIndex = 1
                Bolred = False
            End If
        i = ii + 1
    Loop
    
    'traitement du dernier mot
    If ii < Len(Rg.Text) Then
        If Bolred = False Then
            Rg.Characters(ii + 1, Len(Rg.Text) - ii).Font.ColorIndex = 3
        Else
            Rg.Characters(ii + 1, Len(Rg.Text) - ii).Font.ColorIndex = 1
        End If
    End If
    
End Sub

Tu choisiras!

Edition: Les 2 versions se valent ( même approche globale), la seule différence est dans le fait que Yeahou ne gère qu'un mot sur 2, donc si la cellule est déjà en rouge, rien ne se passe visuellement.( visiblement il était à la bourre ce matin, il n'a pas eu le temps de peaufiner! 😉)

 

[PascalXLD]

Re : Un mot sur 2 de couleur différente dans une même cellule

Bonjour

Bon j'arrive à la bourre

mais voici tout de même

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Byte
Dim Macouleur As Byte

On Error GoTo fin
Macouleur = 1
For x = 1 To Len(Target.Value)
    If Mid(Target.Value, x, 1) = " " Then
        Macouleur = IIf(Macouleur = 1, 3, 1)
    Else
        Target.Characters(x, 1).Font.ColorIndex = Macouleur
    End If
Next
fin:
End Sub

 

[PascalXLD]

Re : Un mot sur 2 de couleur différente dans une même cellule

Re

une amélioration si on modifie plusieurs cellules à la fois

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Byte
Dim Macouleur As Byte
Dim c As Range

Macouleur = 1
For Each c In Target
    For x = 1 To Len(c.Value)
        If Mid(c.Value, x, 1) = " " Then
            Macouleur = IIf(Macouleur = 1, 3, 1)
        Else
            c.Characters(x, 1).Font.ColorIndex = Macouleur
        End If
    Next
Next
End Sub

Bonne journée

 

[Luki]

Re : Un mot sur 2 de couleur différente dans une même cellule

Alors là, je dis : BRAVO Pascal,

Superbe exemple de concision!
Tu mérites vraiment ton statut de Super Barbatruc Moderator ! 😀

Yeahou, je crois que l'on peut aller se recoucher!

 

[zeltron]

Re : Un mot sur 2 de couleur différente dans une même cellule

Merci beaucoup pour toutes ces réponses.

Mais comment appliquer cela seulement à la cellule "A4" par exemple. J'ai essayé d'adapter le code de Pascal76 de la manière suivante , mais cela ne fonctionne pas.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Byte
Dim Macouleur As Byte
On Error GoTo fin
With Range("A4")
Macouleur = 1
For x = 1 To Len(Target.Value)
If Mid(Target.Value, x, 1) = " " Then
Macouleur = IIf(Macouleur = 1, 3, 1)
Else
Target.Characters(x, 1).Font.ColorIndex = Macouleur
End If
Next
End With
fin:
End Sub

Avez vous une idée???

Merci d'avance

Zeltron

 

[zeltron]

Re : Un mot sur 2 de couleur différente dans une même cellule

Cela fonctionne en adaptant le code de Pascal756 de la manière suivante:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Byte
Dim Macouleur As Byte
Dim c As Range

Macouleur = 1
For Each c In Range("A4")

For x = 1 To Len(c.Value)
If Mid(c.Value, x, 1) = " " Then
Macouleur = IIf(Macouleur = 1, 3, 1)
Else
c.Characters(x, 1).Font.ColorIndex = Macouleur
End If
Next
Next
End Sub

Mais pouvez vous me confirmer si cela est adéquat???

Merci d'avance

Zeltron

 

[PascalXLD]

Re : Un mot sur 2 de couleur différente dans une même cellule

Re

Voici que pour la cellule A4 en laissant la possibilité de modifier toute une serie de cellule dont la cellule A4 ferait partie

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Byte
Dim Macouleur As Byte
Dim c As Range

Macouleur = 1
For Each c In Target
    If c.Address = "$A$4" Then
        For x = 1 To Len(c.Value)
            If Mid(c.Value, x, 1) = " " Then
                Macouleur = IIf(Macouleur = 1, 3, 1)
            Else
                c.Characters(x, 1).Font.ColorIndex = Macouleur
            End If
        Next
    End If
Next
End Sub

 

[zeltron]

Re : Un mot sur 2 de couleur différente dans une même cellule

Merci à vous tous pour vos réponses

Merci beaucoup Pascal76 également pour la découverte de la fonction IIF

Bonne journée

Cordialement

Zeltron

 

[Bernard_XLD]

Re : Un mot sur 2 de couleur différente dans une même cellule

Bonjour à tous

bien vu luki, j'étais effectivement à la bourre ce matin et j'ai codé ça avec les pieds, une main tenant la tasse à café, l'autre fermant les boutons et serrant la cravate. Les pannes d'oreiller sont toujours difficiles!

bonne continuation, A+