Microsoft 365 Change d'image en fonction du changement de valeur d'une cellule (résolu)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:A9")) Is Nothing Then
        Smiley
    End If
End Sub

Sub Smiley()
Application.ScreenUpdating = False
    With ActiveSheet
        For Each sh In .Shapes
            sh.Delete
        Next sh
    End With
    With Sheets("Feuil2")
        If .Range("A10") < 46 Then
            NomImage = "Image 1"
        ElseIf .Range("A10") > 50 Then
            NomImage = "Image 2"
        Else
            NomImage = "Image 3"
        End If
    End With

    Sheets("Feuil3").Activate
    ActiveSheet.Shapes.Range(Array(NomImage)).Select
    Selection.Copy
    Sheets("feuil2").Select
    Range("C1").Select
    ActiveSheet.Pictures.Paste.Select
  Application.ScreenUpdating = True
End Sub