Option Explicit
Sub Bild_Einfügen()
Dim pic As Shape
For Each pic In Tabelle1.Shapes
pic.Delete
Next pic
Tabelle1.Range("A4:A2000").ClearContents
Dim i As Integer
Dim desiredWidth As Double
Dim desiredHeight As Double
desiredWidth = 101
desiredHeight = 60
For i = 4 To 2000
If Tabelle1.Cells(i, 2).Value <> "" Then
If Dir(Tabelle1.Cells(i, 2).Value) <> "" Then
With Tabelle1.Shapes.AddPicture(Tabelle1.Cells(i, 2).Value, MsoTriState.msoFalse, MsoTriState.msoCTrue, _
Tabelle1.Cells(i, 1).Left + (Tabelle1.Cells(i, 1).Width - desiredWidth) / 2, _
Tabelle1.Cells(i, 1).Top + (Tabelle1.Cells(i, 1).Height - desiredHeight) / 2, desiredWidth, desiredHeight)
.Placement = xlMoveAndSize
End With
Else
Tabelle1.Cells(i, 1).Value = "X"
End If
End If
Next i
End Sub