Exécution d'une macro automatiquement avec formule dans cellule

Version imprimable

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:

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

14/04/2019, 15h43
78chris

Bonjour

Le recalcul de la formule n'est pas un événement de type Change mais de type Calculate
14/04/2019, 16h17
Motomakasi

1 pièce(s) jointe(s)

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.

Pièce jointe 466663

Merci pour votre retour.

Citation:

Envoyé par 78chris

Bonjour

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

Bonjour à tous

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

Code:

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 :roll: