OVH Cloud OVH Cloud

Colorier le fond des cellules en rouge ou vert suivant le résult at

7 réponses
Avatar
[___FreGoLi___]
Bonjour à tous

Une cellule contient un résultat calculé en fonction d'autres cellules.
Je voudrais que suivant la valeur de ce calcul, la cellule se colorie d'une
couleur particulière.
J'ai essayé ceci:

public sub Couleur1()
activecell.interior.colorindex=3
end sub

public Function MonCalcul(Cell1 as range, Cell2 as range) as variant
Dim Res as variant
Res = Cell1.value - Cell2.value
MonCalcul=Res
Couleur1
End Function

et j'ai mis "=MonCalCul(A1;A2) dans la cellule A3,
ais, même si le calcul s'effectue bien, et que la sub se déroule bien, le
fond de la cellule ne change pas de couleur.
Je pense que c'est parce que certaines propriétés de la cellule active sont
bloquée durant l'évaluation de sa valeur, mais j'aimerai avoir plus
d'explications sur le sujet.

Merci d'avance

7 réponses

Avatar
CAP2
Salut,

tiens-tu vraiment au VBA ?

Parceque sinon, tu sélectionnes ta cellule, puis Format/Mise en forme
conditionnelle, et là tu spécifie ton opérateur et ton critère de
comparaison, et tu détermine la mise en forme à appliquer (bouton Format)...

Ca convient ?

CAP2
Avatar
[___FreGoLi___]
je tiens au VBA parce que les formules de calcul peuvent être un peu plus
compliquées que l'exemple donné et se terminer par un select case pour
colorier.
Mais effectivement, je peux mixer les deux: VBA pour calculer et MEFC pour
colorier, même si il faut faire gaffe à maintenir les deux en parallèle.
Merci en tout cas de ton judicieux conseil.
Avatar
PMO
Bonjour,

L'inconvénient de la mise en forme conditionnelle est que,
si par la suite vous voulez identifier les cellules colorées
par un code VBA quelconque, la couleur ne fait pas partie
de la cellule en tant que propiété.

Ayant, il y a peu de temps, répondu à une question similaire
essayez le code suivant (à adapter selon votre usage)

1) Copiez le code suivant dans un module standard
**********
Public PMO_InteriorColor As Integer
Public PMO_Feuille As String
Public PMO_Adresse As String
Public PMO_Bool As Boolean

Public Function MonCalcul(Cell1 As Range, Cell2 As Range) As Variant
Dim Res As Variant
Res = Cell1.Value - Cell2.Value
'---- A adapter ----
If Res <= 10 Then PMO_InteriorColor = 3
If Res > 10 And Res <= 20 Then PMO_InteriorColor = 43
If Res > 20 Then PMO_InteriorColor = 5
'-------------------
MonCalcul = Res
PMO_Feuille = Application.Caller.Parent.Name
PMO_Adresse = Application.Caller.Address
PMO_Bool = True
End Function
**********

2) Copiez le code suivant dans ThisWorkbook
**********
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If PMO_Bool Then
Sheets(PMO_Feuille).Range(PMO_Adresse) _
.Interior.ColorIndex = PMO_InteriorColor
PMO_Bool = False
End If
End Sub
**********

Cordialement.
--
PMO
Patrick Morange



Bonjour à tous

Une cellule contient un résultat calculé en fonction d'autres cellules.
Je voudrais que suivant la valeur de ce calcul, la cellule se colorie d'une
couleur particulière.
J'ai essayé ceci:

public sub Couleur1()
activecell.interior.colorindex=3
end sub

public Function MonCalcul(Cell1 as range, Cell2 as range) as variant
Dim Res as variant
Res = Cell1.value - Cell2.value
MonCalcul=Res
Couleur1
End Function

et j'ai mis "=MonCalCul(A1;A2) dans la cellule A3,
ais, même si le calcul s'effectue bien, et que la sub se déroule bien, le
fond de la cellule ne change pas de couleur.
Je pense que c'est parce que certaines propriétés de la cellule active sont
bloquée durant l'évaluation de sa valeur, mais j'aimerai avoir plus
d'explications sur le sujet.

Merci d'avance


Avatar
CAP2
OK,

dis-nous un peu les conditions d'attribution des couleurs, et on y regardera
en VBA, si tu veux tout gérer par macro...

CAP2
Avatar
joh[a]n
ça ressemble un peu à mon problème qui est en fait la réalisation d'une
carte de score de golf.
j'ai un par 3 donc un trou a faire en 3 coup et je souhaite qu'en
fonction de mon score réalisé exemple 2 soit attribué une couleur à
cette cellule, si je fais 3 elle reste inchangé si je fais 1 une autre
couleur si je fais 4 encore une autre, 5 encore une autre et 6 encore
une autre :)


Bonjour à tous

Une cellule contient un résultat calculé en fonction d'autres cellules.
Je voudrais que suivant la valeur de ce calcul, la cellule se colorie d'une
couleur particulière.
J'ai essayé ceci:

public sub Couleur1()
activecell.interior.colorindex=3
end sub

public Function MonCalcul(Cell1 as range, Cell2 as range) as variant
Dim Res as variant
Res = Cell1.value - Cell2.value
MonCalcul=Res
Couleur1
End Function

et j'ai mis "=MonCalCul(A1;A2) dans la cellule A3,
ais, même si le calcul s'effectue bien, et que la sub se déroule bien, le
fond de la cellule ne change pas de couleur.
Je pense que c'est parce que certaines propriétés de la cellule active sont
bloquée durant l'évaluation de sa valeur, mais j'aimerai avoir plus
d'explications sur le sujet.

Merci d'avance


Avatar
[___FreGoLi___]
Cette solution est d'enfer.
Elle fonctionne super bien (mais cela ce n'est pas la peine de le dire ;-))).
Je peux ainsi compliquer à loisir la fonction de calcul - coloriage.

Merci et à bientôt
Avatar
[___FreGoLi___]
Super réponse que j'ai immédiatement adopté

Aussi pour "l'améliorer" (si c'est possible), et contribuer au forum avec
une réponse, je joins une modification de la fonction "MonCalcul" qui accepte
deux listes en paramètres:
Le premier paramètre est une liste de cellules qui permettront de faire le
calcul,
Le deuxième paramètre est une liste de cellule qui donneront la couleur à
mettre en fond dès que la valeur calculée sera inférieure ou égale à la
valeur de la cellule colorée en question (bien sûr, il faut qu'elles soient
dans l'ordre)

Ainsi cette fonction est entièrement paramétrée.

Public PMO_InteriorColor As Integer
Public PMO_Feuille As String
Public PMO_Adresse As String
Public PMO_Bool As Boolean

Public Function MonCalcul(Cells As Range, Couleurs As Range) As Variant
Dim Res As Variant
Dim CellIdx As Integer

'---- Calcul très compliqué ----- ;-) mais c'est juste pour exemple
Res = Cells(1).Value - Cells(2).Value
'---- A adapter ----
For CellIdx = 1 To Couleurs.Count
If Res >= Couleurs(CellIdx).Value Then
PMO_InteriorColor = Couleurs(CellIdx).Interior.ColorIndex
End If
Next CellIdx
'-------------------
MonCalcul = Res
PMO_Feuille = Application.Caller.Parent.Name
PMO_Adresse = Application.Caller.Address
PMO_Bool = True
End Function