Excel mit Bilder befüllen
20.10.2013 14:31:49
Bobic
ich hab in einem Ordner unzählige Bilder nach Artikelnummer gespeichert z.B. 0815, 1111, ....
In der Spalte A trage ich die Artikelnummer ein z.B. 0815, 11111, ... Die Anzahl der Artikelnummern variiert zwischen 30 und 200 Stück. Ich würde also jedes mal gerne zwischen 30 und 200 Bilder passend zur Artikelnummer einfügen.
Das Bild soll dann in der gleichen Zeile stehen, wie die Artikelnummer:
Spalte A, Spalte B
0815.......Bild 0815
11111.....Bild 1111
33333.....Bild 3333
...................
Das Bild soll dann an automatisch an die Größe der Zeile angepasst werden.
Mein Lösungsansatz ist nun folgender:
Sub BilderEinfügen()
Dim Pfad As String
Dim Dateiname As String
Dim objShape As Object
Pfad = "C:\Users\..."
Dateiname = Range("A1")
Set objShape = Sheets("Tabelle1").Pictures.Insert( _
Pfad & "\" & Dateiname & ".jpg")
With objShape
.Left = Cells(lngRow + 2, 2).Left
.Top = Cells(lngRow + 1, 1).Top
.Height = Range("B1").Height
.Width = .Height * 3 / 4
End With
Set objShape = Nothing
Pfad = "C:\Users\..."
Dateiname = Range("A2")
Set objShape = Sheets("Tabelle1").Pictures.Insert( _
Pfad & "\" & Dateiname & ".jpg")
With objShape
.Left = Cells(lngRow + 2, 2).Left
.Top = Cells(lngRow + 2, 2).Top
.Height = Range("B1").Height
.Width = .Height * 3 / 4
End With
Set objShape = Nothing
End Sub
Das Makro funktioniert auch wunderbar, es hat nur zwei Probleme:
Aktuell fügt es mir nur zwei Bilder ein, ich müsste also ein Teil des Codes 200 mal kopiere und die Daten (Dateiname = Range("A2"))manuell anpassen. Das ist irgendwie sehr aufwendig.
Habe ich in einer Zelle keine Artikelnummer eingetragen, wird kein Bild eingetragen. Gut soweit, aber das Makro stoppt hier und macht nicht mit der nächsten Zeile weiter, welche wieder eine Artikelnummer hat.
Habt ihr vielleicht eine Lösung?