Der Code gehts insgesamt super. Er stellt Bilder nach Vorgaben von Zelle A in die Zelle F.
Ich habe mit dem o.a. Code nur zwei Probleme und bitte um Hilfe. Bei den Namen der Bilder habe ich keine reinen Zahlen, sondern z.B. 1234-Malta, 5678-Kalif usw. Was muß ich statt Value dortt reingeben, das das klappt. Zweitens: Wenn noch kein Bild vorhanden ist, dann steigt er auch aus. Kann man da was machen, das er trotz allem alles weiterverarbeitet ?
Danke
chris
Public Sub Bild_gemaess_Vorgabezeile_einfuegen()
Dim rngZielbildzelle As Range
Dim rngBildnamenzelle As Range
Dim Reihe As Long
Reihe = 2 'Startzeile wo die Artikelnummern beginnen
'erstmaliges Setzen der Ranges
'hier als Beispiel 1 = Spalte A mit Artikelnummer/Bildname und 3 = Spalte C wo das Bild rein _
kommt
Set rngBildnamenzelle = ActiveSheet.Range(Cells(Reihe, 1), Cells(Reihe, 1))
Set rngZielbildzelle = ActiveSheet.Range(Cells(Reihe, 6), Cells(Reihe, 6))
'Jetzt Zeile für Zeile durchlaufen, bis eine leere Zelle ohne Artikelnummer gefunden wird
Do Until ActiveSheet.Cells(Reihe, 1).Value = ""
'Hier ggfs die Endung des Bildes (jpg, gif etc anpassen)
'und ggs auch noch den Pfad der Bilder anpassen. Hier gehe ich davon aus, die Bilder liegen da, _
wo auch die Exceldatei liegt
With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\Bilder\" & rngBildnamenzelle.Value & " _
.jpg").Top = rngZielbildzelle.Top + 1
.Left = rngZielbildzelle.Left + 1
.Height = 199 'hier Bildhöhe anpassen
.Width = 200 'hier Bildbreite anpassen
End With
'hier Zellgröße anpassen
rngZielbildzelle.ColumnWidth = 37.4 'Spaltenbreite (nicht identisch mit Bildbreitenwert!)
rngZielbildzelle.RowHeight = 200 'Zellhöhe würde ich 1 größer machen als Bildhöhe
'Zähler raufsetzen
Reihe = Reihe + 1
'hier den Range neu setzen fürs nächste Bild, Spalten wie oben anpassen
Set rngBildnamenzelle = ActiveSheet.Range(Cells(Reihe, 1), Cells(Reihe, 1))
Set rngZielbildzelle = ActiveSheet.Range(Cells(Reihe, 6), Cells(Reihe, 6))
Loop
'ActiveWorkbook.Save 'ggfs. automatisches speichern der Exceldatei
End Sub