Hvorfor virker denne Sub ikke?? tilføje billeder ved ændring af celle.

Den sletter bare det billede der allerede er sat ind i arket...


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim shpTemp As Shape, lTop As Long, lTeft As Long, lWidth As Long, lHeight As Long
    If Target.Address = "$D$2" Then
        lTop = Range("C3").Top
        lleft = Range("C3").Left
        lWidth = 50
        lHeight = 50
        ActiveSheet.Pictures.Delete
        Select Case Target
            Case Target.Value = "NO"
              Set shpTemp = ActiveSheet.Shapes.AddPicture("C:\NO-flag.gif", True, False, lleft, lTop, lWidth, lHeight)
            Case Target.Value = "SE"
                Set shpTemp = ActiveSheet.Shapes.AddPicture("C:\SE-flag.gif", True, False, lleft, lTop, lWidth, lHeight)
            Case Target.Value = "DK"
                Set shpTemp = ActiveSheet.Shapes.AddPicture("C:\dk-flag.gif", True, False, lleft, lTop, lWidth, lHeight)
            Case Else
              Exit Sub
        End Select
        Set shpTemp = Nothing
    End If
End Sub