Bilddatei importieren, wenn Teil = Artikelnummer

Hallo zusammen,
nachdem ich fleißig umherrecherchiert habe, ohne etwas
Passendes zu finden, möchte ich euch doch mit meinem
Problem belästigen.
Es geht darum, in Excel Bilder von Artikeln zu importieren.
Der Name der Bilddatei ist dabei immer gleich aufgebaut als
EAN Code verfügbar :
4190508504806-0012004.jpeg
wobei die Stellen 4 bis 8 der Artikelnummer und die Stellen
15 bis 21 der Ausführung entsprechen. Im obigen Fall eben
05085 für die Artikelnummer und 0012004 für die Ausführung.
Der Aufbau ist logischerweise immer gleich und die Länge des
Dateinamens ebenso.
Ich möchte nun das jeweilige Bild des Artikels in ein Arbeits-
blatt importieren, wenn der User Artikelnummer und Ausführung
in A1 und A2 eingegeben hat.
Es sollte doch möglich sein, alle Bilddateien im Zielverzeichnis
darauf hin zu prüfen, ob sie die Artikelnummer und Ausführungs-
nummer an den Stellen 4 bis 8 bzw. 15 bis 21 enthalten. Um, wenn
dem so ist die entsprechende Bilddatei zu importieren.
Doch wie komme ich an Teile eines Dateinamens, um diese dann mit
dem Inhalt bestimmter Zellen im Arbeitsblatt abzugleichen ?
Viele Grüße
R.Schmitt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub sJpegListen() Dim strFilename As String strFilename = Dir("Z:\Bilder\*.JPEG", vbNormal) Do While strFilename <> vbNullString If Len(strFilename) > 21 Then Debug.Print Mid(strFilename, 4, 5), Mid(strFilename, 15, 7) End If Dir Loop End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim StBild As String Dim InI As Integer Dim zelle ' löscht alle Bilder auf dem aktuellen Blatt, For InI = ActiveSheet.Shapes.Count To 1 Step -1 If Left(ActiveSheet.Shapes(InI).Name, 3) = "Pic" Then ActiveSheet.Shapes(InI).Delete End If Next zelle = Range("A1").Value 'in dem Pfad sind alle Bilder gespeichert => "D:/Bildkatalog/" & zelle & ".jpg" StBild = "D:/Bildkatalog/" & ActiveCell & ".jpg" If Dir(StBild) <> "" Then ActiveSheet.Shapes.AddPicture StBild, True, True, 530, 150, 150, 130 Else End If End Sub

Hallo
Hier mal meine Versuche.
- rechte Maustaste auf daen Tabellenblattreiter unten
- Code anzeigen
- diesen Code reinkopieren

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:B1")) Is Nothing Then
Dim Pfad$, Bild$, Ext$, Datei$, JN$
On Error Resume Next
Pfad = "C:\Temp\" 'anpassen
Ext = ".jpeg"
Datei = Dir(Pfad & "*" & Ext)
JN = ""
ActiveSheet.Shapes("Bild").Delete 'altes Bild weg
Do While Datei <> "" And JN <> "J"
If Len(Datei) = 26 Then 'nur diese Dateien
If Mid(Datei, 4, 5) = Cells(1, 1).Value Then 'Artikelnummer enthalten?
If Mid(Datei, 15, 7) = Cells(1, 2).Value Then 'Ausfuhrung enthalten?
JN = "J"
Cells(1, 3).Select 'hier wird das Bild eingetragen C1
ActiveSheet.Pictures.Insert(Pfad & Datei).Name = "Bild" 'Pic wird eingefügt und als "Bild" benannt
End If
End If
End If
Datei = Dir
Loop
If JN = "" Then MsgBox "Kein entsprechendes Bild gefunden"
End If
End Sub

Überwacht werden die Zellen A1 und B1
Datei hier: https://www.herber.de/bbs/user/28472.xls
Gruß UweD
(Rückmeldung wäre schön)

Beliebteste Forumthreads (12 Monate)

Bilddatei importieren, wenn Teil = Artikelnummer

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread