Sub GraphicfileInZelleEinfuegen()
Dim aktZeile As Long
Dim spalte As Long
Dim anfangsZeile As Long
Dim ws As Worksheet
Dim pfad As String
spalte = 5
anfangsZeile = 1
pfad = "C:\Neuer Ordner\"
Set ws = ThisWorkbook.Worksheets("Tabelle1")
With ws
On Error Resume Next
.Pictures.Delete
On Error GoTo 0
For aktZeile = .Cells(.Rows.Count, 1).End(xlUp).Row To anfangsZeile Step -1
If (Cells(aktZeile, 1).Text) = "" Then
Else
If Dir(pfad & "\" & .Cells(aktZeile, 1).Text & ".jpg") = "" Then
.Cells(aktZeile, spalte) = "Bild fehlt"
Else
With .Pictures.Insert(pfad & "\" & .Cells(aktZeile, 1).Text & ".jpg")
.Top = ws.Rows(aktZeile).Top
.Height = ws.Rows(aktZeile).Height
.Left = ws.Columns(spalte).Left
End With
End If
End If
Next aktZeile
End With
End Sub