Hallo Karl-Heinz,

vielen Dank für deien Hilfe.

Der neue Code lautet wie folgt:

Option Explicit

Sub Bild_Einfügen()

    '**********************************************
    ' Bilder aus einem bestimmten Bereich löschen
    Dim pic As Shape
    For Each pic In Tabelle1.Shapes
        pic.Delete
    Next pic
    '**********************************************

    '**********************************************
    ' Zell-Inhalte aus einem bestimmten Bereich löschen
    Tabelle1.Range("A4:A2000").ClearContents
    '**********************************************

    Dim i As Integer
    Dim desiredWidth As Double
    Dim desiredHeight As Double

    ' Setzen Sie die gewünschte Breite und Höhe
    desiredWidth = 101
    desiredHeight = 60

    ' For-Schleife für alle Zeilen
    For i = 4 To 2000
        ' Überprüfen, ob die Zelle nicht leer ist
        If Tabelle1.Cells(i, 2).Value <> "" Then
            ' Überprüfen, ob die Bilddatei existiert
            If Dir(Tabelle1.Cells(i, 2).Value) <> "" Then
                ' Bild einbetten mit "Von Zellposition und -größe abhängig" Option
                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 ' "Von Zellposition und -größe abhängig" Option
                End With
            Else
                ' Pfad nicht vorhanden
                Tabelle1.Cells(i, 1).Value = "X"
            End If
        End If
    Next i
End Sub

Gruß

Aaron