XL 2019 Changement couleur police avec cellules fusionnées

Jacques25bis · 20 Août 2021

Bonjour à tous,

Après quelques recherche j'ai réussi à faire un code pour le changement de couleur des caractères de mes cellules :

Private Sub CommandButton1_Click()
Dim r As Range
For Each r In Range("A10:A15")
Longueur = Len(r)
For j = 1 To Longueur
If r.Characters(Start:=j, Length:=1).Font.Color = 255 Then 'rouge
r.Characters(Start:=j, Length:=1).Font.Color = 8696052 'rouge clair
Else
r.Characters(Start:=j, Length:=1).Font.Color = 14395790 'bleu clair
End If
Next j
Next r
End Sub

Ca ne marche pas sur l'ensemble de mes cellules, sur la première cellule (A10) il me change bien le 1er caractère mais les autres passent en bleu clair. Idem pour la 3ème cellule (A13)
Je pensai que ça venant de la fusion des cellules mais à priori non.

Je vous joins un fichier avec le code et les données colorées (en double pour les essais)

Merci de votre aide.

@ plus

Jack

Jacques25bis · 20 Août 2021

Re-Bonjour,

J'essaye dans tous les sens mais je n'arrive à rien (cellules fusionnées ou pas) à priori quand la couleur au début du texte est rouge il ne fait que la 1ère lettre, sinon si la première lettre est bleu tout se passe bien... J'en perd mon latin...
J'ai essayé d'inscrire le code couleur de tous les caractères dans des cellules en colonne ça fonctionne
J'ai essayé avec .color et .colorindex le résultat est le même.

Si toutefois vous y comprenez qqchose je suis tout ouïe

@ plus

Jack

Dranreb · 20 Août 2021

Bonjour
Peut être auriez vous oublié que si un caractère est devenu rouge pâle il n'est plus rouge et passe donc en bleu ?

Jacques25bis · 20 Août 2021

Bonjour Dranreb,

Pourquoi quand la 1ère lettre est bleu ça marche correctement quelque soit les couleurs derrières?
Comment puis-je corriger si ça vient de cet oubli?

Merci

Jack

Dranreb · 20 Août 2021

Essayez comme ça :

VB:

Private Sub CommandButton1_Click()
   Dim Cel As Range, P As Integer, R As Byte, B As Byte
   For Each Cel In Range("A10:A15")
      For P = 1 To Len(Cel.Value)
         With Cel.Characters(Start:=P, Length:=1).Font
            R = .Color And &HFF: B = .Color \ &H10000
            .Color = IIf(R > B, &H547FFF, &HFFAE81)
            End With
         Next P, Cel
   End Sub

Jacques25bis · 20 Août 2021

Re,

Ca me donne le même résultat...

Dranreb · 20 Août 2021

Joignez le classeur modifié, parce que chez moi ça marche.

Jacques25bis · 20 Août 2021

Le voici

Dranreb · 20 Août 2021

Effectivement ça ne marche plus avec vos données.
On dirait que le changement de couleur du 1er caractère change la couleur de toute la cellule.
Alors on va changer de stratégie :

VB:

Private Sub CommandButton1_Click()
   Dim Cel As Range, P As Integer, TCoul() As Long, R As Byte, B As Byte
   For Each Cel In Range("A10:A15")
      ReDim TCoul(0 To Len(Cel.Value))
      For P = 1 To Len(Cel.Value)
         With Cel.Characters(Start:=P, Length:=1).Font
            R = .Color And &HFF: B = .Color \ &H10000
            TCoul(P) = IIf(R > B, &H547FFF, &HFFAE81)
            End With
         Next P
      For P = 1 To Len(Cel.Value)
         Cel.Characters(Start:=P, Length:=1).Font.Color = TCoul(P)
         Next P, Cel
   End Sub

Jacques25bis · 20 Août 2021

Ca parfait ça marche nickel, je vais éplucher le code pour le comprendre, en attendant un grand merci, j'ai passé quelques heures dessus...

Bon week end.

Jack

XL 2019 Changement couleur police avec cellules fusionnées

Jacques25bis

XLDnaute Junior

Pièces jointes

Jacques25bis

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Jacques25bis

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Jacques25bis

XLDnaute Junior

Dranreb

XLDnaute Barbatruc

Jacques25bis

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

Jacques25bis

XLDnaute Junior

Discussions similaires