Private Sub Worksheet_Change(ByVal Target As Range)
Dim Pfad As String, Ext As String
Dim RngName As Range, RngBild As Range
Set RngName = Range("AN27")
Set RngBild = Range("AO13")
Pfad = "C:\Users\NB01\Documents\HR-Manager\DATEN & VORLAGEN\Foto Mitarbeiter\"
Ext = ".jpg"
If Not Intersect(Target, RngName) Is Nothing Then
If Target "" Then
'Prüfung ob Bild zu diesem Namen vorhanden ist
If Dir(Pfad & Target & Ext) = "" Then 'Foto fehlt
MsgBox Target & " nicht vorhanden!!!"
Else ' Bild vorhanden
With Me.Pictures.Insert(Pfad & Target & Ext)
.Name = "Foto"
.Left = RngBild.Left
.Top = RngBild.Top
End With
End If
Else
On Error Resume Next
Me.Shapes("Foto").Delete
On Error GoTo 0
End If
End If
End Sub