Excel Makro fügt Photos in falsche Zeile ein

Question

Hallo Leute,

Habe ein Problem mit Excel. Zum automatischen Einfügen von Fotos in ein Excel-sheet habe ich folgenden Code benutzt:

Option Explicit

Sub Bilder_einfügen()

Dim strPfad As String, lngWiederholungen As Long
Dim picBild As Picture
On Error Resume Next
strPfad = " J:\Prospekt_Bilder\"
For lngWiederholungen = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set picBild = ActiveSheet.Pictures.Insert(strPfad & Cells(lngWiederholungen, 1) & ".jpg")
With picBild
.Top = Cells(lngWiederholungen, 6).Top
.Left = Cells(lngWiederholungen, 6).Left
.Height = 400
End With
Next lngWiederholungen
Set picBild = Nothing
End Sub

Das Problem ist aber, dass bei einigen Zeilen, Fotos fehlen und in einer anderen wieder auftauchen. Kann mir irgendjemand dabei helfen?

Danke schon mal im Voraus!
pm

Answer 1

Hi,

das Problem dabei ist, dass der Codeablauf schneller ist als Excel die Bilder an der richtigen Position einfügen kann.
Du kannst es versuchen, indem du zuerst alle Bilder ohne Positionierung einfügst und dann in einer weiteren Schleife sie an die gewünschte Position setzt.

Bis später,
Karin

Answer 2

Sry aber ich bekommes einfach nicht hin... könntest du mir Starthilfe geben?

Answer 3

Hallo pm. Dein Code sieht soweit richtig aus. Bev. schein schon auf der richtigen Spur zu sein. Bevor wir aber die Laufzeit über Application.Wait oder For To Next unnötig verlängern versuch erst mal folgendes:

Statt

Set picBild = ActiveSheet.Pictures.Insert(strPfad & Cells(lngWiederholungen, 1) & ".jpg")

lieber

ActiveSheet.Pictures.Insert(strPfad & Cells(lngWiederholungen, 1) & ".jpg")
Set picBild = ActiveSheet.Shapes(IngWiederholungen)

Damit greifst du erst dann auf das Shape zu, nachdem das Bild geladen wurde. Lösche aber zuvor alle bestehende Bilder damit auch die richtigen geladen werden. Der Trick klappt nur, wenn nicht noch andere Objekte (z.b. Checkboxen) im Sheet enthalten sind.

Gruß Mr. K.

Answer 4

Hallo Mr. K.,

Danke erstmal für deine Hilfe!
Habe es gerade ausprobiert, jedoch fügt Excel nun alle Bilder übereinander ein, und das auch noch in Originalgröße.

Hast du eine Ahnung warum?
LG
pm

Answer 5

Hi,

Sub Bilder_einfügen()
Dim strPfad As String, lngWiederholungen As Long
Dim picBild As Picture
strPfad = "J:\Prospekt_Bilder\"
On Error Resume Next
For lngWiederholungen = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Set picBild = ActiveSheet.Pictures.Insert(strPfad & Cells(lngWiederholungen, 1) & ".jpg")
Next lngWiederholungen
DoEvents
Application.Wait Now + TimeValue("00:00:04")
For lngWiederholungen = 1 To ActiveSheet.Pictures.Count
With ActiveSheet.Pictures(lngWiederholungen)
.Top = Cells(lngWiederholungen, 6).Top
.Left = Cells(lngWiederholungen, 6).Left
.Height = 400
End With
Next lngWiederholungen
Set picBild = Nothing
End Sub

Eventuell musst du noch berücksichtigen, wenn du außer den eingefügten Bildern ein oder mehrere Steuerelemente im Tabellenblatt hast - die musst du dann aus dem Schleifendurchlauf ausklammern.

Bis später,
Karin

Answer 6

Hallo pm,

ich sehe, was du meinst. Das ist ja crazy! Ich hoffe Beverly konnte dir helfen. Bei mir haben alle drei hier vorgestellten Varianten versagt.

Mein Fazit: Excel stößt bei der Darstellung sehr vieler großer Bilder an seine Leistungsgrenzen und bekommt Performance-Probleme. Da die Bilder zudem richtig in das Dokument eingefügt werden, würde es wohl selbst bei funktionierender Anzeige spätestens beim Speichern oder Öffnen des Dokuments Probleme geben, ganz zu schweigen von der Platzverschwendung auf der Festplatte.

Mein Tipp: Verzichte auf die Anzeige der Bilder und verknüpfe stattdessen die Dateinamen in Spalte 1 auf das entsprechende Bild per Hyperlink.
Füge dazu innerhalb der Schleife ALS EINZIGE ZEILE folgendes ein.

ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngWiederholungen, 1), Address:= _
Pfad & Cells(lngWiederholungen,1) &".JPG"

Solltest du jedoch auf der Anzeige der Bilder bestehen, schlage ich einen Wechsel der Applikation hin zu Microsoft Access vor. Bestehende Excel-Daten kannst du dort importieren. Dort lässt sich auch ein Feld anlegen, das etwas besser mit Bildern umgehen kann.

Gruß Mr. K.

Answer 7

Hallo an alle,

Habs nach ewigem Hin und Her einigermaßen hinbekommen, leider gibts noch immer den einen oder anderen Fehler.

@Mr. K.: Hast recht, kein einziger hier vorgestellter Code hat funktioniert! Habe in mal umgeschrieben...
Probleme gibts aber noch ein paar, obwohl ich keinen Fehler in meinen Überlegungen entdecken konnte.

Vl probier ichs wirklich mal mit Access.

Danke für eure Hilfe!

pm

Answer 8

Zitat: "kein einziger hier vorgestellter Code hat funktioniert!"

Poste doch mal deinen "umgeschriebenen" Code.

Wie viele Bilder sind es denn?

Bis später,
Karin

Answer 9

Folgender Code funktioniert bei mir mit 750 Bildern

Sub Bilder_einfügen()
Dim strPfad As String, lngWiederholungen As Long
Dim picBild As Picture
strPfad = "J:\Prospekt_Bilder\"
Application.ScreenUpdating = False
For lngWiederholungen = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Dir("J:\Prospekt_Bilder\" & Cells(lngWiederholungen, 1) & ".jpg") <> "" Then
Set picBild = ActiveSheet.Pictures.Insert(strPfad & Cells(lngWiederholungen, 1) & ".jpg")
End If
Next lngWiederholungen
DoEvents
Application.Wait Now + TimeValue("00:00:04")
For lngWiederholungen = 1 To ActiveSheet.Pictures.Count
With ActiveSheet.Pictures(lngWiederholungen)
.Top = Cells(lngWiederholungen, 6).Top
.Left = Cells(lngWiederholungen, 6).Left
.Height = 400
End With
Next lngWiederholungen
Application.ScreenUpdating = True
Set picBild = Nothing
End Sub

Bis später,
Karin

Bis später,
Karin