Discussion :

[Motomakasi]

Bonjour à tous,

J'aimerais exécuter une macro automatiquement lorsque la valeur d'une cellule change.
Le problème est que la cellule contient une formule et ma macro ne fonctionne pas (sauf si je change moi-même la valeur ce que je ne souhaite pas)

Voici mon code qui fonctionne très bien mais manuellement. Il consiste à changer la couleur (RGB) de
la forme (= objet dessin dénommé "ARA", "EPA" et "DHA") en fonction des valeurs entrées dans les cellules
E20; E21, et E22. Sauf que ces valeurs sont issues d'une formule (E20=SI(ESTERREUR(A4);0;A4) par exemple).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Worksheet_Change(ByVal Target As Range) 
'Updateby Extendoffice 20160704 
 
If Intersect(Target, Range("E20:E22")) Is Nothing Then Exit Sub 
 
Select Case Target.Row 
	Case 20: Set sh = ActiveSheet.Shapes("ARA") 
	Case 21: Set sh = ActiveSheet.Shapes("EPA") 
	Case 22: Set sh = ActiveSheet.Shapes("DHA") 
End Select 
 
If IsNumeric(Target.Value) Then 
	If Target.Value >= 50000 Then 
		sh.Fill.ForeColor.RGB = RGB(255, 192, 0) 
	ElseIf Target.Value < 50000 And Target.Value >= 5000 Then 
		sh.Fill.ForeColor.RGB = RGB(251, 221, 41) 
 
	Else 
		sh.Fill.ForeColor.RGB = RGB(230, 230, 230) 
	End If 
End If 
End Sub

[78chris]

Bonjour

Le recalcul de la formule n'est pas un événement de type Change mais de type Calculate

[Motomakasi]

Merci pour votre prompt retour.

Je suis passé en mode Calculate sans succès. Je m'y prends surement mal étant novice.
Je vous envoie le fichier (simplifié) pour vous en rendre compte. Je colle les nvlles valeurs à partir d'un autre fichier sur les cellules D2:F2, ces valeurs sont reprises dans E14:E16 avec la formule =SI(ESTERREUR(D2);0;D2) par ex. La macro devrait tenir compte de ces nvlles valeurs.

pijenyal_test.xls

Merci pour votre retour.

Bonjour

Le recalcul de la formule n'est pas un événement de type Change mais de type Calculate

[78chris]

Bonjour à tous

Si c'est la copie en D2: F2 qui déclenche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160704
 
    If Intersect(Target, Range("D2:F2")) Is Nothing Then Exit Sub
    For Each Cellule In Range("E14:E16")
        If IsNumeric(Cellule.Value) Then
            Select Case Cellule.Row
                Case 14: Set sh = ActiveSheet.Shapes("ARA")
                Case 15: Set sh = ActiveSheet.Shapes("EPA")
                Case 16: Set sh = ActiveSheet.Shapes("DHA")
            End Select
            If Cellule.Value >= 50000 Then
                sh.Fill.ForeColor.RGB = RGB(255, 192, 0)
            ElseIf Cellule.Value < 50000 And Cellule.Value >= 5000 Then
                sh.Fill.ForeColor.RGB = RGB(251, 221, 41)
            ElseIf Cellule.Value < 5000 And Cellule.Value >= 500 Then
                sh.Fill.ForeColor.RGB = RGB(255, 255, 0)
            ElseIf Cellule.Value < 500 And Cellule.Value >= 50 Then
                sh.Fill.ForeColor.RGB = RGB(255, 255, 153)
            ElseIf Cellule.Value < 50 And Cellule.Value >= 5 Then
                sh.Fill.ForeColor.RGB = RGB(255, 255, 204)
            ElseIf Cellule.Value < 5 And Cellule.Value >= 0.8 Then
                sh.Fill.ForeColor.RGB = RGB(255, 255, 230)
            Else
                sh.Fill.ForeColor.RGB = RGB(230, 230, 230)
            End If
        End If
    Next Cellule
End Sub

Edit : salut Eric. Je comprends ta réaction