Makro Bilder in Excel einfügen

Hallo zusammen,
ich füge per Makro Bilder aus einem Ordner in eine Excel Datei ein. Die Bilder werden dauerhaft eingebettet so dass die Liste auch per Mail weitergeschickt werden kann.
Das Makro sieht so aus:


Sub Bilder_einfügen_funkt()
Dim strPfad As String, lngWiederholungen As Long
Dim picBild As Shape
On Error Resume Next
strPfad = "V:\Shopfotos 22-1\"
For lngWiederholungen = 1 To Cells(Rows.Count, 3).End(xlUp).Row
On Error Resume Next
ActiveSheet.Shapes(Cells(lngWiederholungen, 1)).Delete
On Error Resume Next
Set picBild = ActiveSheet.Shapes.AddPicture(strPfad & Cells(lngWiederholungen, 3) & ".jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=Cells(lngWiederholungen, 1).Left, Top:=Cells(lngWiederholungen, 1).Top, Width:=Cells(lngWiederholungen, 1).Width, Height:=Cells(lngWiederholungen, 1).Height)
Next lngWiederholungen
Set picBild = Nothing
End Sub

Jetzt bräuchte ich noch 2 Dinge.
1) Wenn in einer Zelle kein Bild eingefügt werden kann, da das Bild noch nicht vorhanden ist, sollte in der Zelle "no picture found" stehen. Kann jmd mein Makro entsprechend umgestalten?
2) Es gibt noch eine zweite Excel Liste. In diese sollen die Bilder ebenfalls eingefügt werden. Die Bilder sind immer unter diesem Format abgespeichert: 922726 X_112_05 (Artikelnummer_Farbe_Vorderansicht). Es gibt also zum Beispiel die Artikelnummer 922726 X in 3 Farben. In meiner 1. Excel Liste sind alle Farben aufgeführt. In der 2. Excel Liste steht nur die Artikelnummer und es ist egal welche Farbe eingefügt wird, Hauptsache es wird ein Bild eingefügt. Also zum Beispiel gibt es den Artikel 922726 X in Farbe 123, 124 & 125. Es ist aber aktuell nur ein Bild von Farbe 124 vorhanden, genau dieses Bild soll eingefügt werden auch wenn der Bilder Dateiname 922726 X_124_05 lautet und in der Datei nur die Artikelnummer 922726 X steht. Lässt sich mein Makro hierzu ändern?
Ich freue mich über Hilfe und bedanke mich schon vorab für jeden Beitrag!
Hier befindet sich die Datei:
https://www.herber.de/bbs/user/148746.xlsm

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub InsertPitures() Const FOLDER_PATH As String = "V:\Shopfotos 22-1\" Dim lngRow As Long Dim strPath As String, strfFilename As String Dim objShape As Shape Application.ScreenUpdating = False For Each objShape In ActiveSheet.Shapes If objShape.Type = msoPicture Then Call objShape.Delete Next For lngRow = 2 To Cells(Rows.Count, 3).End(xlUp).Row If Dir$(FOLDER_PATH & Cells(lngRow, 3).Value & ".jpg") = vbNullString Then strfFilename = Split(Cells(lngRow, 3).Value, " ")(0) strfFilename = Dir$(FOLDER_PATH & strfFilename & "*.jpg") If strfFilename vbNullString Then strPath = FOLDER_PATH & strfFilename Else strPath = FOLDER_PATH & Cells(lngRow, 3).Value & ".jpg" End If With Cells(lngRow, 1) If strPath = vbNullString Then .Value = "no picture found" Else Call ActiveSheet.Shapes.AddPicture(strPfad, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height) End If End With Next lngRow Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro Bilder in Excel einfügen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread