Bilder in Excel automatisch einfügen

[DaliaSin]

Ich bin schon schier am Verzweifeln. Ich habe eine umfangreiche Excel-Tabelle mit vielen eingebundenen Bildern. Mittlerweile ist die Tabelle
bereits >50 MB und nicht mehr perfomant. :s

Jetzt hatte ich gedacht mit einem Makro würde es funktionieren die Bilder automatisch anhand der ID einzufügen pro Spalte. Da ich immer wieder
neue Datensätze bekomme und ich die grafiken immer per hand reinkopiere. Was echt mühsam ist.
Die direkte Ansicht brauche ich um alles gleich zuordnen zu können.

Zuerst habe ich an Kommentar gedacht. Aber da pflege ich ja auch wieder von Hand.

Dann hab ich mal ein bisschen mit Marko rumprobiert aber bis auf die Fehlermeldung "kein Bild gefunden" passiert nichts. ICh weis nicht woran es liegt. :(
Ist hier ein Makro Spezialist der mir evtl. helfen kann?

Hier mal das was ich jetzt seit stunden versuche um es zum laufen zu bringen.

Code:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim Bildbreite As Single
Dim Bildhöhe As Single
Dim meinBild
Dim maxSpaltenbreite As Single
Dim Bild As Shape
Dim Zelle As Range

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad anpassen
Pfad = "C:\Users\PC\Desktop\AM-Web-Office\Bilder\"
'Spalte B ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 4).Value
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
 'falls ja, dann Bildhöhe und -breite einlesen
 Set meinBild = LoadPicture(strDatnam)
 Bildbreite = meinBild.Width
 Bildhoehe = meinBild.Height

 'Bild einfügen, 9 cm hoch - 1 cm = 28,35 pt - und Breite entsprechend skaliert
 ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 1).Left, Cells(Wiederholungen, 1).Top, 255.15 * Bildbreite / Bildhoehe, 255.15
 'maximale Spaltenbreite ermitteln, für die Anpassung der Spaltenbreite
 If maxSpaltenbreite < 255.15 * Bildbreite / Bildhoehe Then maxSpaltenbreite = 255.15 * Bildbreite / Bildhoehe
 Else
 'falls nein, wird in Spalte A eine Fehlermeldung geschrieben
 ActiveSheet.Cells(Wiederholungen, 1) = "Bild nicht gefunden"
End If
Next

'Zeilenhöhe anpassen
Rows("2:" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).RowHeight = 259

'Spaltenbreite anpassen
Columns("A:A").ColumnWidth = (WorksheetFunction.RoundUp(maxSpaltenbreite / 5, 0) + 2)

'Alle Bilder im Blatt in Zelle zentrieren
For Each Bild In ActiveSheet.Shapes
         
With Bild.TopLeftCell
  Set Zelle = Cells(.Row, .Column)
End With
   
Bild.Top = Zelle.Top + (Zelle.Height - Bild.Height) / 2
Bild.Left = Zelle.Left + (Zelle.Width - Bild.Width) / 2
           
Next

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub


Jemand ne Idee wo es nicht passt.