XL 2019 MFC ou VBA pour couleur de cellule

K

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
sylvanu
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.
Trier par date Trier par votes
sylvanu

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
Vote positif 0 Vote négatif
Solution
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Kev, Gdinfo,
GDINFO à dit:
mais comment je créer les 40 valeurs
Cliquez pour agrandir...
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.
 
Vote positif 0 Vote négatif
G

GDINFO

XLDnaute Junior
Supporter XLD
sylvanu à dit:
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.
Cliquez pour agrandir...
Oui j’ai posé une question bête
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
G

GDINFO

XLDnaute Junior
Supporter XLD
sylvanu à dit:
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
Cliquez pour agrandir...
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,
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
G

GDINFO

XLDnaute Junior
Supporter XLD
sylvanu à dit:
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
Cliquez pour agrandir...
Super . Merci je vais adapté et mettre en place , cela évitera de lancer la macro
trop bien 👍
 
Vote positif 0 Vote négatif
sylvanu

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
 
Vote positif 0 Vote négatif
Dranreb

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
Vote positif 0 Vote négatif

Discussions similaires

Yann71
  • Question
Microsoft 365 Compter le nombre de cellule mise en couleur avec MFC
2
Réponses
19
Affichages
599
job75
job75
D
  • Question
Microsoft 365 Compter les couleur avec MFC
2
Réponses
19
Affichages
675
TooFatBoy
TooFatBoy
T
  • Question
XL 2021 Additionner la couleur du fond et la police de plusieurs cellule en vba
Réponses
7
Affichages
290
Tophe2
T
treza88
  • Question
Microsoft 365 Fonction perso ref couleur Hexa en couleur de fond de cellule
2
Réponses
24
Affichages
807
Dudu2
Dudu2
M
  • Résolu(e)
Microsoft 365 colorier une rangée de cellules
2
Réponses
15
Affichages
707
Marvin57
M
P
  • Résolu(e)
XL pour MAC Problème de changement de couleur de la valeur d'une cellule
Réponses
2
Affichages
223
pvander
P
V
  • Question
XL 2016 Convertir un format de date
Réponses
3
Affichages
637
vivi21
V
A
  • Résolu(e)
Microsoft 365 Compter cellule de couleur.
2
Réponses
27
Affichages
2 K
Anto35200
A
jeff1494
  • Question
XL 2021 [Résolu] MFC et tableau structuré
Réponses
14
Affichages
247
jeff1494
jeff1494
E
  • Question
Microsoft 365 Couleurs de fichiers qui changent
Réponses
1
Affichages
225
mapomme
mapomme

Membres actuellement en ligne

3 membres et 62 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 655
Messages
2 111 605
Membres
111 217
dernier inscrit
aladinkabeya2