Bilder automatisch in Excel in ein bestimmte Zelle einfügen

Question

Hallo,

ich benötige eure Hilfe.

Ich versuche vergeblich folgendes Makro zu kreeiren....
Ergebnis soll sein das ein Bild automatisch durch Eingabe einer Modellnummer in einem Vorgegeben Raster erscheint.

Beispiel: Modelnummer (format 1.111.1111) in Zelle C3, C20, C37 usw.
Fotos liegen als .jpeg auf einem Pfad
Eingefügt soll das Bild immer in in dem darunter befindlichen Raster erfolgen
Beispiel: A5, A22, A39 usw.

Das Raster hat ca. 30-40 Raster untereinander und nochmal die gleiche Anzahl rechts daneben wo die Modellnummer in der Spalte L sich befindet.

So und wenn das nicht schon genug wäre :-)
Benötige ich auf die Selbe Art ein weiteres Makro:

Modellnummer (format 1.111.1111) in Zelle C3, C4, C5 usw
Fotos liegen als .jpeg auf einem Pfad
Eingefügt soll das Bild immer links erfolgen
Beispiel: B3, B4, B5 usw.

Hoffe mir kann jemand hier helfen :-)

Danke und viele Grüsse,

Julia

Answer 1

Hallo Julia,

ich habe deine Beschreibung zwar gelesen, aber ganz klar ist mir nicht was du willst.

Ich gehe daher einfach mal davon aus, dass die Modellnummer in den Zellen C3, C20, C37 usw stehen und die Bilder in die Zellen A5, A22, A39 etc. eingefügt werden sollen.

Den Pfad und die Saklierung musst du nach deinen Bedürfnissen anpassen.

Sub BilderEinfuegen()
Dim zeile As Long
Dim pfad As String
Dim bild As String
Dim lzeile As Long

'Pfad für die Bilder - anpassen!!!
pfad = "C:\Test\Bilder\"

'Alles spielt sich auf dem aktuellen Arbeitsblatt ab
With ActiveSheet

'letzte Zeile in Spalte C des Arbeitsblattes ermitteln
lzeile = .Cells(Rows.Count, 3).End(xlUp).Row

'Ab Zeile 3 die Zeilen durchlaufen
For zeile = 3 To lzeile Step 17

'Name des Bildes einlesen und die Endung .jpg hinzufügen und mit Pfad-Konstante kombinieren
bild = pfad & .Cells(zeile, 3).Value & ".jpg"

'prüfen, ob überhaupt ein Bild vorhanden ist
If Len(Dir(bild)) = 0 Then
.Cells(zeile + 2, 1) = "Kein Bild mit dem Namen " & .Cells(zeile, 3).Value & ".jpg gefunden!"
Else
'Bild einfügen
.Pictures.Insert (bild)
With .Pictures(.Pictures.Count)
.Top = Cells(zeile + 2, 1).Top 'Zelle in der das Bild eingefügt wird - oben
.Left = Cells(zeile + 2, 1).Left 'links
.ShapeRange.ScaleWidth 0.25, msoFalse, msoScaleFromTopLeft 'Bild skalieren - Breite
.ShapeRange.ScaleHeight 0.25, msoFalse, msoScaleFromTopLeft 'Höhe
End With
End If

Next zeile

End With

End Sub

Gruß

M.O.