Wie Artikeliste automatisch mit Bildern per Makro befüllen? In Mappe speichern nicht verknüpfen!

Sub InsertPicures()
    'Variablen  
    Dim intWidth As Integer, intHeight As Integer, objSize As Object, regex As Object, fso As Object, objShell As Object, file As Object, nsFolder As Object, cell As Range, dblRatio As Double, rngTargetCell As Range, strFilePath As String, intNewWidth As Integer, intNewHeight As Integer, percentHeight As Single, percentWidth As Single, pRatio As Single, intPosHor As Integer, BILDERPFAD as String, IMAGEEXTENSION as String
    'Pfad in dem die Bilder liegen  
    BILDERPFAD = "D:\Temp\munkees-total"  
    'Dateierweiterung der Bilder  
    IMAGEEXTENSION = ".jpg"  
    'Objekte  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set objShell = CreateObject("Shell.Application")  
    Set regex = CreateObject("vbscript.regexp")  
    'regex settings  
    regex.Global = True: regex.IgnoreCase = True: regex.MultiLine = False
    regex.Pattern = "(\d+).*?(\d+)"  
    'Namespace Object für Ordner erstellen  
    Set nsFolder = objShell.Namespace(BILDERPFAD)
    'Aktuelles Arbeitsblatt  
    With ActiveSheet
        ' Für jede Zell von A2:A(Ende)  
        For Each cell In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)  
            'vollständiger Pfad des Bildes  
            strFilePath = BILDERPFAD & "\" & cell.Value & IMAGEEXTENSION  
            'Zielzelle für das Bild (Zelle gleich neben dem Namen des Bildes)  
            Set rngTargetCell = cell.Offset(0, 1)
            'Wenn das Bild existiert  
            If fso.FileExists(strFilePath) Then
                'Hole eine Referenz zur Datei  
                Set file = nsFolder.ParseName(cell.Value & IMAGEEXTENSION)
                'Lese die Dimension des Bildes aus  
                Set objSize = regex.Execute(nsFolder.GetDetailsOf(file, 31))
                'wenn die Größe extrahiert werden konnte...  
                If objSize.Count > 0 Then
                    intWidth = objSize(0).submatches(0)     'Breite des Bildes  
                    intHeight = objSize(0).submatches(1)    'Höhe des Bildes  
                     
                    'Passe die Dimensionen des Bildes an die Zielzelle an  
                    percentHeight = rngTargetCell.Height / intHeight
                    percentWidth = rngTargetCell.Width / intWidth
                    pRatio = IIf(percentHeight < percentWidth, percentHeight, percentWidth)
                    intNewWidth = intWidth * pRatio
                    intNewHeight = intHeight * pRatio
                    
                    ' Hochformatbilder Horizontal in der Zelle zentrieren  
                    intPosHor = (rngTargetCell.Width - intNewWidth) / 2
                    
                    'Füge das Bild in die Zelle als embedded Image ein welches mit der Arbeitsmappe gespeichert wird  
                    .Shapes.AddPicture strFilePath, msoFalse, msoTrue, rngTargetCell.Left + intPosHor, rngTargetCell.Top, intNewWidth, intNewHeight
                Else
                    rngTargetCell.Value = "Bildgröße konnte nicht extrahiert werden!"  
                End If
            Else
                rngTargetCell.Value = "Bild wurde nicht gefunden!"  
            End If
        Next
    End With
    Set fso = Nothing
    Set objShell = Nothing
    Set regex = Nothing
End Sub