XL 2019 Changement couleur police avec cellules fusionnées

Jacques25bis

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

Pièces jointes

  • essai couleur.xls
    72 KB · Affichages: 11

Jacques25bis

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

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

Dranreb

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

Discussions similaires

Réponses
0
Affichages
83