Actualisation formule VBA

Bonjour à tous,

J'ai créé une petite macro permettant de coloriser automatiquement une forme en fonction d'une valeur cible:

Si la Valeur dans la case est "A", alors la couleur est verte, si la valeur est "B", alors une autre couleur et ainsi de suite.

La macro fonctionne. Par contre, je suis obligé de systématiquement cliquer sur la formule de la case qui contient la lettre pour mettre en marche la macro :

=SI(B79<=5;"A";SI(ET(B79>5;B79<=15);"B";SI(ET(B79>15;B79<=30);"C";SI(ET(B79>30;B79<=60);"D";SI(ET(B79>60;B79<=100);"E";SI(B79>100;"F";0))))))

Merci par avance !

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 3 And Target.Row = 78 Then

        If ActiveSheet.Cells(78, 3).value = "A" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(0, 122, 55)
        ElseIf ActiveSheet.Cells(78, 3).value = "B" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(0, 176, 80)
        ElseIf ActiveSheet.Cells(78, 3).value = "C" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(146, 208, 80)
        ElseIf ActiveSheet.Cells(78, 3).value = "D" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(255, 255, 0)
        ElseIf ActiveSheet.Cells(78, 3).value = "E" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(255, 192, 0)
        ElseIf ActiveSheet.Cells(78, 3).value = "F" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(237, 125, 49)
        ElseIf ActiveSheet.Cells(78, 3).value = "G" Then
            ActiveSheet.Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(255, 0, 0)

        End If

    End If

End Sub

Bonjour

Pour ma part, j'utilisais ce type de formule

Private Sub Worksheet_SelectionChange(ByVal Target As
 Range)
    call MacroDeTest
End Sub 

à mettre dans la feuille de calcul mais je peux me tromper

Bonsoir,

Votre formule dépend du changement de quelle cellule ? la B79 ?

Et si oui est-ce vous qui changez la valeur ou pas

Crdlt

Edit : essayez ceci

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target.Dependents, Range("C78")) Is Nothing Then
    Select Case Cells(78, 3).Value
        Case Is = "A"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(0, 122, 55)
        Case Is = "B"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(0, 176, 80)
        Case Is = "C"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(146, 208, 80)
        Case Is = "D"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(255, 255, 0)
        Case Is = "E"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(255, 192, 0)
        Case Is = "F"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(237, 125, 49)
        Case Is = "G"
            Shapes.Range(Array("Rectangle 68", "Isosceles Triangle 69")).Fill.ForeColor.RGB = RGB(255, 0, 0)
    End Select

End If
End Sub

Cordialement

Bonsoir,

Merci beaucoup pour votre retour rapide, effectivement avec votre méthode, cela fonctionne correctement !

Merci à tous pour vos réponses,

Bonne soirée !