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é.
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.
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.
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.
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.
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
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,
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
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
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 : Regarde la pièce jointe 1136340
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)
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)