Nimm besser die Shapes.Add Methode, ist flexibler

Option Explicit

Sub BesserBilder_Einfuegen()
'
'
Dim Path As String
Dim Func As String
Dim Form As String
Dim i As Integer
Dim j As Integer
Dim oShp As Shape

'wegen Test auskommentiert / geändert **********
Rem Path = "XXX\"
Rem Func = ActiveSheet.Name
Rem Form = ".png"
Form = ".jpg"
'***********************************************
'
i = 2
j = 3

While (i < 180) '18 Zeilen
While (j < 6) ' 3 Spalten

    'Cells(i, j).Select wozu??
   
On Error Resume Next
   
   'einfach mit den Parametern(Pflicht) herumspielen
    Set oShp = ActiveSheet.Shapes.AddPicture( _
      Filename:=Path & Cells(i, j).Value & Func & Form, _
      LinkToFile:=msoFalse, _
      SaveWithDocument:=msoTrue, _
      Left:=Cells(i, j + 3).Left, _
      Top:=Cells(i, j).Top, _
      Width:=Cells(i + 10, j).Top - Cells(i, j).Top, _
      Height:=Cells(i + 10, j).Top - Cells(i, j).Top)
      
  If Err.Number = 0 Then
    'jetzt alle weiteren möglichen Eigenschaften
    With oShp
      'Test (kann natürlich auch der Zellinhalt sein)
      .Name = "Pict " & Cells(i, j).Address(0, 0)
    End With
    'Test++++++++++++++++++++++++++++++++++++++++++++++
   Call MsgBox("Bild " & oShp.Name & vbNewLine & _
               "an Position " & oShp.TopLeftCell.Address, _
               vbInformation, _
               "Gewonnen!")
   End If
   
On Error GoTo 0

    
    j = j + 1
    
Wend

    i = i + 10 'Zeilen immer zu 10. zusammengefasst "Easy Scroling"
    j = 3 'Erste Spalte ist C
Wend


End Sub


Sub Bonus()
'lösche alle Bilder wo der Zelleintrag fehlt
Dim oShp As Shape
Dim arrN() As String

   For Each oShp In ActiveSheet.Shapes
      arrN = Split(oShp.Name, " ")
      If Range(arrN(1)).Value = "" Then
         If MsgBox("Bild " & oShp.Name & vbNewLine & _
               "an Position " & oShp.TopLeftCell.Address, _
               vbQuestion + vbYesNo, _
               "Sicherheitsabfrage!") = vbYes Then oShp.Delete
      End If
   Next oShp

End Sub