indsæt billede automatisk

Hej

Jeg har lånt dette script, som kan sætte billede ind når jeg har skrevet filnavn i et felt. det virker fint bortset fra en ting.

hvis feltet er helt tomt, så skriver den mangler billede, det er ok
og den sætter billede ind hvis den kan finde det.

problemet er at hvis der ikke er en fil med det navn som jeg har tastet, så bruger den bare det sidste billede, hvilket ikke er det rigtige.

Er der en venlig sjæl der kan tilføje/ændre lidt i sriptet.

Function INSERTPIC(sFullName As String) As Variant

    Dim rng1 As Range, rCall As Range
    Dim oShp As Object, sFName As String
    Dim dblLeft As Double, dblRight As Double
    Dim dblHeight As Double, dblWidth As Double
    Dim dblTop As Double, dblBottom As Double
   
    If Dir(sFullName, vbNormal) = "" Then
        INSERTPIC = "Bad file path/name"
        Exit Function
    End If
    sFName = Right(sFullName, Len(sFullName) - InStrRev(sFullName, "\"))
    Set rCall = Application.Caller
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   
    For Each oShp In ActiveSheet.Shapes
        Set rng1 = Range(oShp.TopLeftCell, oShp.BottomRightCell)
        If Not Intersect(rng1, rCall) Is Nothing Then
            oShp.Delete
        End If
    Next
   
    Set oShp = rCall.Parent.Pictures.Insert(sFullName)
    dblTop = rCall.Top
    dblLeft = rCall.Left
    dblBottom = rCall.Offset(1, 0).Top
    dblRight = rCall.Offset(0, 1).Left
    dblWidth = dblRight - dblLeft
    dblHeight = dblBottom - dblTop
   
    oShp.Top = dblTop
    oShp.Left = dblLeft
    oShp.Width = dblWidth
    oShp.Height = dblHeight
   
    INSERTPIC = sFName
   
    Application.ScreenUpdating = True
    Application.EnableEvents = True
   
End Function