Makro Bilder in Excel einfügen

Forumthread: Makro Bilder in Excel einfügen

22.10.2021 14:26:19

lele

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

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro Bilder in Excel einfügen

22.10.2021 15:47:17

Nepumuk

AW: Makro Bilder in Excel einfügen

22.10.2021 15:47:17

Nepumuk

Hallo lele,
teste mal:


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

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Forumthread: Makro Bilder in Excel einfügen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread