Bilder automatisch in Excel einfügen 2

Question

Hallo,

ich habe hier: https://supportnet.de/fresh/2005/11/id1193541.asp schon hilfreiche Tips
gefunden, allerdings funktioniert das bei mir nicht.
Ich glaube meine Bilder sind zu groß - was kann ich da machen (um nicht alle einzeln kleiner
abspeichern zu müssen)

Habe in meiner Excel-Tabelle die Bildnamen stehen und möchte nun die Bilder zuordnen.
Alternativ würde es mir sogar reichen, einfach nur die Bildliste in Excel als Spalte zu importieren -
brauche den Namen nicht zwangsläufig (falls das einfacher wäre)

Würde mich sehr über Hilfe freuen - bin leider sehr unerfahren.
DANKE!
Elena

Answer 1

Hallo Elena,

du kannst dir mal diese Threads anschauen:
Link 1
Link 2

Hier werden die Bilder skaliert eingefügt. Solltest du nicht klar kommen, dann stelle mal deinen Tabellenaufbau dar (in welcher Spalte stehen die Bildnamen, in welche Spalten sollen die Bilder eingefügt werden und wie groß?)

Gruß

M.O.

Answer 2

Hallo M.O.
Danke! Das in Link 1 könnte das richtige Makro sein, habe folgendes
benutzt:

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 maxBildhöhe As Single
Dim Bild As Shape
Dim Zelle As Range

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'Pfad anpassen
Pfad = "C:\Test\"
'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, 2).Value & ".jpg"
'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, 5 cm Breit - 1 cm = 28,35 pt - und Höhe entsprechend
skaliert
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue,
Cells(Wiederholungen, 1).Left, Cells(Wiederholungen, 1).Top, 141.75,
141.75 * Bildhoehe / Bildbreite
'maximale Bildhöhe ermitteln, für die Anpassung der Zeilenhöhe
If maxBildhöhe < 141.75 * Bildhoehe / Bildbreite Then maxBildhöhe =
141.75 * Bildhoehe / Bildbreite
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 = maxBildhöhe + 4

'Spaltenbreite anpassen
Columns("A:A").ColumnWidth = 35

'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

Habe jetzt einfach die Namen der Bilder in Spalte B gemacht und meinen
Pfad eingefügt, das passt also.

Zum allerersten Mal ist überhaupt etwas passiert bei meinem
CommandButton - leider aber nur in Spalte A überall "Bild nicht
gefunden"
Meine Bilder haben auch unterschiedliche Formate und können in Spalte
A sein. Gerne dürften sie auch etwas größer in der Tabelle sein, vllt so 8-
10 cm hoch.
Und meine Bildnamen heißen jeweils mit ".jpg" am Ende, habe das zum
Test ein paar mal gelöscht, aber auch an diesen Stellen funktioniert es
nicht und es erscheint "Bild nicht gefunden". Damit ich das nicht überall
löschen muss wäre es besser, das Makro mit ".jpg" zu programmieren.
Was muss ich dazu unter "Namen der Bilder - ohne Endung" genau
löschen?

Ich bin dennoch schon unendlich dankbar!
Liebe Grüße,
Elena

Answer 3

Hallo Elena,

du musst in der Zeile

'Pfad anpassen
Pfad = "C:\Test\"

natürlich den Pfad eingeben, in dem du deine Bilder abgelegt hast, damit diese eingefügt werden.

Wenn deine Bilder z.B. in deinem persönlichen Bildordner liegen, dann musst du schreiben

Pfad = "C:\Users\Elena\Pictures\"

Und achte bitte auch darauf, dass der Pfad mit einem \ abschließt.

Ich habe den Code so modifiziert, dass
- du die Bilder mit der Endung in die Spalte B (ab Zeile 2) schreiben kannst
- und die Bilder 9 cm hoch skaliert eingefügt werden.

Hier der geänderte 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:\Test\"
'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, 2).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

Gruß

M.O.

Answer 4

Tausend Dank, M.O. - du scheinst ein Held zu sein!

Nun habe ich noch ein (hoffentlich) letztes Problem:
Ich möchte dasselbe nun für mehrere Tabellenblätter machen, dort sind jeweils andere Bilder und ich habe für die nächste Tabelle ein neues Modul mit dem entsprechenden
Pfad erstellt und einen neuen CommandButton reingetan. Habe es auch in beiden Kästen in der VB-Steuerung umbenannt in Bilder_einfügen2 (vorher kam allerdings
derselbe folgende Fehler, als ich nur den Pfad ausgetauscht habe):

Excel bringt zuerst eine Fehlermeldung (Pfad nicht gefunden), wenn ich dann auf Beenden klicke, zeigt es aber trotzdem Bilder an, jedoch werden die Spalten nicht
angepasst und somit sind die Bilder nicht wirklich sichtbar. Woran kann das schon wieder liegen?

Liebe Grüße,
Elena

Answer 5

Hallo Elena,

liegen die Bilder der anderen Tabellenblätter in einem anderem Pfad? Denn eigentlich brauchst du das Makro nicht zu kopieren, wenn die Namen in allen Tabellen in Spalte B stehen und die Bilder in Spalte A eingefügt werden sollen.
Falls die Bilder auf den jeweiligen Blättern jeweils in einem anderen Pfad stehen, könnte man den jeweiligen Pfad z.B. über den Button übergeben.

Wenn der Fehler auftaucht, dann drücke nicht auf Beenden sondern auf Debuggen. Dann öffnet sich das VBA-Projekt und eine Zeile ist gelb hinterlegt. Poste dann mal diese Zeile, damit man sieht, wo der Fehler auftaucht.

Gruß

M.O.

Answer 6

Hallo M.O.,

ja, die Bilder liegen für jede Tabelle in einem anderen Pfad (unterschiedliche Unterordner in einem Ordner).

Was bedeutet es, den Pfad über den Button zu übergeben? Kann ich denn einen einzigen Button für die ganze Mappe verwenden? (habe jetzt in das neue Tabellenblatt einen
neuen Button eingefügt und eben auch ein neues Modul dazu erstellt)

Beim Debuggen wird diese Zeile gelb:
Set meinBild = LoadPicture(strDatnam)

Liebe Grüße,

Elena

Answer 7

Hallo Elena,

nein, das bedeutet, dass du über die Buttons in den einzelnen Tabellenblättern dem Makro mitteilst, in welchem Verzeichnis die Bilder liegen, die in das jeweilige Tabellenblatt eingefügt werden sollen.

Füge dazu das folgende Makro in ein Standard-Modul deiner Arbeitsmappe ein:

Sub Bilder_einfügen(strPfad 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

'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 = strPfad & Cells(Wiederholungen, 2).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

Für die Buttons in den jeweiligen Blättern sieht der Code dann z.B. so aus:

Private Sub CommandButton1_Click()
Dim strPfad As String

strPfad = "C:\Test\"

Call Bilder_einfügen(strPfad)

End Sub

Den Pfad musst dann natürlich für jedes Blatt entsprechend anpassen.

Der Fehler bei deinem Makro kommt daher, dass er das Bild öffnen kann, weil entweder der Pfad unvollständig oder falsch ist oder der Dateiname des Bildes unvollständig oder falsch ist. Also überprüfe mal, ob alles richtig geschrieben ist und ob bei den Bilder die richtigen Endungen hinterlegt sind.

Gruß

M.O.

Answer 8

Hallo Elena,

nochmal ich ;-).

Natürlich könnte man das Makro auch so ändern, dass alle Blätter der Arbeitsmappe druchlaufen und - abhängig von Blattnamen - die Bilder aus dem richtigen Pfad in die jeweilige Tabelle einfügt werden.

Gruß

M.O.

Answer 9

Hallo M.O.,

nun habe ich mich weiter daran versucht. Das neue Makro und die Lösung mit dem jeweiligen Pfad in die einzelnen Buttons habe ich verstanden, das klingt gut. Danke!
Dann brauche ich keine andere Version, in der alle Blätter durchlaufen werden.

Es hakt leider immer noch an dem "Laufzeitfehler 76: Pfad nicht gefunden". Die Zeile " Set meinBild = LoadPicture(strDatnam)" wird nach wie vor gelb, obwohl ich nun
mehrfach überprüft habe, dass die Pfade stimmen und auch die Bildbezeichnungen stimmen (habe sie aus dem Explorer reinkopiert und den \ eingefügt am Ende) und das an
mehreren Tabellenblättern ausprobiert habe. Das ist ja eigentlich nicht so schwer - aber ich komme nicht weiter.

Kennt jemand noch weiter mögliche Fehlerursachen, die ich noch überprüfen könnte?

Liebe Grüße
Elena

Answer 10

Hallo Elena,

bist du auf einem Windows-Rechner oder auf einem Mac unterwegs (da ist das mit der Pfadangabe schwieriger)?.

Blende dir mal im VBA-Editor das Lokal-Fenster ein (das findest du im Menü Ansicht).
Dann lasse noch einmal das Makro laufen und wenn der Fehler kommt, dann klicke auf debuggen.
Im Lokalfenster kannst du dir jetzt den Inhalt der Variablen (u.a. strPfad und strDatnam) ansehen und kontrollieren.

Falls der Pfad oder die Bildnamen falsch wären, dann müsste in Spalte A "Bild nicht gefunden" stehen.
Hast du auch vollen Zugriff auf das Verzeichnis / die Bilder?

Ansonsten speichere mal eine leere Arbeitsmappe mit dem folgenden Makro in ein Bildverzeichnis und führe dann das Makro aus.

Sub pfad()
Range("A1") = ThisWorkbook.Path
End Sub

Damit wird der aktuelle Pfad in Zelle A1 geschrieben und du kannst den Pfad noch einmal kontrollieren.

Gruß

M.O.