Changer la couleur de police auto suivant le chiffre excel

Résolu
PYGOS69 Messages postés 452 Date d'inscription   Statut Membre Dernière intervention   -  
PYGOS69 Messages postés 452 Date d'inscription   Statut Membre Dernière intervention   -

Bonjour,

Dans une cellule J2, je saisis un chiffre.

Je souhaite que la couleur de police de caractères se change automatiquement.

Par mise en forme conditionnelle liée à la table des couleurs ?

Exemple :

Je saisis 3 = couleur rouge

Je saisis 6 = couleur jaune

Il existe 56 couleurs

56 couleurs qui sont listés de A5 à B60

Sub CouleursDeBaseEnVBA()

For i = 1 To 56
   Cells(i, 1).Value = i
   Cells(i, 2).Interior.ColorIndex = i
Next i
End Sub

Ensuite avec une fonction, j'additionne les chiffres de même couleur que J2

en

I2 =SommeCouleurTexte($C$2:$H$3;J2)

Function SommeCouleurTexte(champ As Range, couleurTexte)
    Application.Volatile
    Dim c, temp
    temp = 0
    For Each c In champ
      If c.Font.ColorIndex = couleurTexte Then
         If IsNumeric(c.Value) Then temp = temp + c.Value
      End If
    Next c
    SommeCouleurTexte = temp
End Function

J'ai bien 3 chiffres en rouge, qui en les additionnant font 8 (1+2+5)


Merci d'avance,

Cordialement,

A voir également:

1 réponse

Réponse 1 / 1
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 

Bonjour,

a mettre dans le module de la feuille concernée

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Target.Font.ColorIndex = Target.Value
End Sub

1
PYGOS69 Messages postés 452 Date d'inscription   Statut Membre Dernière intervention   21
 

Bonjour cs_Le Pivert,

Un grand MERCI !

Juste sur la cellule J2 ,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'
'Macro pour changer la police de caractères suivant le chiffre indiqué qui correspond à une couleur en J2
Dim KeyCells As Range
Set KeyCells = Range("J2")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

Target.Font.ColorIndex = Target.Value
End If
End Sub

@+

1