XL 2019 MFC ou VBA pour couleur de cellule

Kev1407

XLDnaute Nouveau
Bonjour,

Je cherche un moyen de mettre en couleur mes cellules en fonction de la valeur de celle-ci.

Dans les colonnes C2:G1000 je voudrais rechercher toutes les nombres identique et les mettre de la même couleur.

J'ai pensé à un truc dans le genre
Sub couleur ()
Range("C2:G1000").select
if cell.value = 1 then
cell.value font.colorindex = 3

and if cell.value = 2
cell.value font color index = 4

et ainsi de suite, par exemple pour que toute les valeur à 1 dans ces colonne devienne rouge la valeur 2 devienne verte etc...

Le problème c'est que je n'arrive pas à l'écrire correctement.
Pouvez vous m'aider, car j'ai tenté la MFC mais j'ai plus de 40 valeur différente cela risque de faire une grosse mise en forme et choisir les couleur est compliqué.

Merci de votre aide.

Cordialement
 
Solution
Bonjour Kev, et bienvenu sur XLD,
Une possibilité en PJ avec :
VB:
Sub couleur()
Dim C
For Each C In Range("C2:G1000")
    Select Case C.Value
        Case 1: C.Font.ColorIndex = 3
        Case 2: C.Font.ColorIndex = 6
        Case 3: C.Font.ColorIndex = 8
        Case 4: C.Font.ColorIndex = 10
        Case 5: C.Font.ColorIndex = 12
        Case 6: C.Font.ColorIndex = 14
        Case 7: C.Font.ColorIndex = 16
        Case 8: C.Font.ColorIndex = 18
        Case 9: C.Font.ColorIndex = 20
    End Select
Next C
End Sub
Il "suffit" de construire la liste des 40 valeurs désirées.

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kev, et bienvenu sur XLD,
Une possibilité en PJ avec :
VB:
Sub couleur()
Dim C
For Each C In Range("C2:G1000")
    Select Case C.Value
        Case 1: C.Font.ColorIndex = 3
        Case 2: C.Font.ColorIndex = 6
        Case 3: C.Font.ColorIndex = 8
        Case 4: C.Font.ColorIndex = 10
        Case 5: C.Font.ColorIndex = 12
        Case 6: C.Font.ColorIndex = 14
        Case 7: C.Font.ColorIndex = 16
        Case 8: C.Font.ColorIndex = 18
        Case 9: C.Font.ColorIndex = 20
    End Select
Next C
End Sub
Il "suffit" de construire la liste des 40 valeurs désirées.
 

Pièces jointes

  • Classeur4.xlsm
    15.4 KB · Affichages: 8

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kev, Gdinfo,
mais comment je créer les 40 valeurs
Je ne comprends pas. Il vous suffit de continuer :
VB:
Sub couleur()
Dim C
For Each C In Range("C2:G1000")
    Select Case C.Value
        Case 1: C.Font.ColorIndex = 3
        Case 2: C.Font.ColorIndex = 6
        Case 3: C.Font.ColorIndex = 8
        ......
        Case 39: C.Font.ColorIndex = 51
        Case 40: C.Font.ColorIndex = 18
    End Select
Next C
End Sub
A ce sujet, il existe une approche plus simple à écrire et à exécuter, mais peut être plus complexe à comprendre. En mettant les couleurs dans un tableau :
Code:
Option Explicit: Option Base 1
Sub Couleur()
Dim C, Couleur, a
Couleur = Array(3, 6, 8, 10, 12, 14, 16, 18, 20)
For Each C In Range("C2:G1000")
    On Error Resume Next
    C.Font.ColorIndex = Couleur(C.Value)
Next C
End Sub
La valeur de la cellule pointe directement la couleur à appliquer en lisant la table Couleur.
" On Error Resume Next" évite les erreurs si la valeur de la cellule pointe au delà du tableau. Par ex si C.value=999 alors Couleur(999) n'existe pas.
 

GDINFO

XLDnaute Junior
Supporter XLD
Bonjour Kev, Gdinfo,

Je ne comprends pas. Il vous suffit de continuer :
VB:
Sub couleur()
Dim C
For Each C In Range("C2:G1000")
    Select Case C.Value
        Case 1: C.Font.ColorIndex = 3
        Case 2: C.Font.ColorIndex = 6
        Case 3: C.Font.ColorIndex = 8
        ......
        Case 39: C.Font.ColorIndex = 51
        Case 40: C.Font.ColorIndex = 18
    End Select
Next C
End Sub
A ce sujet, il existe une approche plus simple à écrire et à exécuter, mais peut être plus complexe à comprendre. En mettant les couleurs dans un tableau :
Code:
Option Explicit: Option Base 1
Sub Couleur()
Dim C, Couleur, a
Couleur = Array(3, 6, 8, 10, 12, 14, 16, 18, 20)
For Each C In Range("C2:G1000")
    On Error Resume Next
    C.Font.ColorIndex = Couleur(C.Value)
Next C
End Sub
La valeur de la cellule pointe directement la couleur à appliquer en lisant la table Couleur.
" On Error Resume Next" évite les erreurs si la valeur de la cellule pointe au delà du tableau. Par ex si C.value=999 alors Couleur(999) n'existe pas.
Oui j’ai posé une question bête
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Evidemment, mais seulement avec le premier ex, puisque la valeur ne peut pas servir d'index à la table couleur le second ex ne marche pas.
Essayez :
VB:
Sub couleur()
Dim C
For Each C In Range("C2:G1000")
    Select Case C.Value
        Case "Mot1": C.Font.ColorIndex = 3
        Case "Mot2": C.Font.ColorIndex = 6
        Case "Mot3": C.Font.ColorIndex = 8
        Case "Mot4": C.Font.ColorIndex = 10
        Case "Mot5": C.Font.ColorIndex = 12
        Case "Mot6": C.Font.ColorIndex = 14
    End Select
Next C
End Sub
 

GDINFO

XLDnaute Junior
Supporter XLD
Re,
Evidemment, mais seulement avec le premier ex, puisque la valeur ne peut pas servir d'index à la table couleur le second ex ne marche pas.
Essayez :
VB:
Sub couleur()
Dim C
For Each C In Range("C2:G1000")
    Select Case C.Value
        Case "Mot1": C.Font.ColorIndex = 3
        Case "Mot2": C.Font.ColorIndex = 6
        Case "Mot3": C.Font.ColorIndex = 8
        Case "Mot4": C.Font.ColorIndex = 10
        Case "Mot5": C.Font.ColorIndex = 12
        Case "Mot6": C.Font.ColorIndex = 14
    End Select
Next C
End Sub
Oui c’est bien ce que j’ai mis . Suivant votre modèle ,très satisfait
est il possible que la macro s’exécute automatiquement après changement de la valeur saisie,
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Oui bien sur, avec une macro événementielle, à mettre obligatoirement dans la feuille concernée.
Et surtout ne pas changer le nom de cette macro.
Elle s'exécutera à chaque fois qu'une cellule de la feuille sera modifiée.
Code:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub ' Fin si plusieurs cellules sont sélectionnées
    ' La suite ne s'éxécutera que si la la cellule concernée est dans cette plage
    If Not Intersect(Target, Range("A1:B10")) Is Nothing Then   ' Adapter la plage utile A1:B10
         On Error GoTo Fin:
         Application.EnableEvents = False                       ' Interdit tout nouvel événement
         Application.ScreenUpdating = False                     ' Fige l'écran
         ' Choix couleur
        Select Case Target                                      ' Target est la valeur de la cellule modifiée
            Case "Mot1": Target.Font.ColorIndex = 3
            Case "Mot2": Target.Font.ColorIndex = 6
            Case "Mot3": Target.Font.ColorIndex = 8
            Case "Mot4": Target.Font.ColorIndex = 10
            Case "Mot5": Target.Font.ColorIndex = 12
            Case "Mot6": Target.Font.ColorIndex = 14
        End Select
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 

GDINFO

XLDnaute Junior
Supporter XLD
Re,
Oui bien sur, avec une macro événementielle, à mettre obligatoirement dans la feuille concernée.
Et surtout ne pas changer le nom de cette macro.
Elle s'exécutera à chaque fois qu'une cellule de la feuille sera modifiée.
Code:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub ' Fin si plusieurs cellules sont sélectionnées
    ' La suite ne s'éxécutera que si la la cellule concernée est dans cette plage
    If Not Intersect(Target, Range("A1:B10")) Is Nothing Then   ' Adapter la plage utile A1:B10
         On Error GoTo Fin:
         Application.EnableEvents = False                       ' Interdit tout nouvel événement
         Application.ScreenUpdating = False                     ' Fige l'écran
         ' Choix couleur
        Select Case Target                                      ' Target est la valeur de la cellule modifiée
            Case "Mot1": Target.Font.ColorIndex = 3
            Case "Mot2": Target.Font.ColorIndex = 6
            Case "Mot3": Target.Font.ColorIndex = 8
            Case "Mot4": Target.Font.ColorIndex = 10
            Case "Mot5": Target.Font.ColorIndex = 12
            Case "Mot6": Target.Font.ColorIndex = 14
        End Select
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Super . Merci je vais adapté et mettre en place , cela évitera de lancer la macro
trop bien 👍
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Ceci étant dit, pour se référer au titre de ce post "MFC ou VBA pour couleur de cellule" vous pourriez utiliser simplement une MFC :
1649491146324.png
 

Dranreb

XLDnaute Barbatruc
Bonjour
Information.
Mon objet Couleur possède une propriété CP en lecture seule donnant un couleur de police garantissant un bon contraste avec la couleur de fond (propriété C en lecture/écriture)
 

Pièces jointes

  • CouleursGDINFO.xlsm
    40.3 KB · Affichages: 10

Discussions similaires

Réponses
4
Affichages
186
Réponses
16
Affichages
197

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG