Grafik mit Zellwert vergleichen und einfügen

Forumthread: Grafik mit Zellwert vergleichen und einfügen

09.01.2006 17:25:32

Enrico

Hallo Profis...
Ich hab' da ein riesen mega Problem.
Nun... das Ganze sieht so aus.
Ich fotografiere eine Modekollektion, speichere die Bilder in einen Ordner und benenne die Bilder jeweils mit der Artikelnummer.
Ich habe ein sogenanntes REF-Blatt entwickelt. Dieses Blatt muss ich für jeden Artikel erfassen. Unter anderem erfasse ich da die Artikelnummer des Teils. Es wäre nun wunderprächtig, wenn mir Excel nach der Eingabe der jeweiligen Artikelnummer automatisch das entsprechende Bild sucht und in einer vorgegebenen Grösse einfügen würde. Das wäre wirklich riesig, wenn ich da einen Tipp von einem Profi bekommen könnte.
Liebe Grüsse und schon mal Danke
Enrico
https://www.herber.de/bbs/user/29861.xls

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Grafik mit Zellwert vergleichen und einfügen

10.01.2006 11:35:44

th.heinrich
Ne Alternative

10.01.2006 11:51:39

Peter
AW: Ne Alternative

10.01.2006 19:26:03

Enrico

AW: Grafik mit Zellwert vergleichen und einfügen

10.01.2006 11:35:44

th.heinrich

hi Enrico,
von Beate Schmitz
https://www.herber.de/bbs/user/29884.xls
gruss thomas

Ne Alternative

10.01.2006 11:51:39

Peter

Servus,
hast zwar von Thomas schon ein Bsp. bekommen, aber falls die Bilder noch nicht in der Datei sein sollten, geht das evtl. so.
Code gehört ins Klassenmodul Tabelle1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address(0, 0) <> "B4:F4" Then Exit Sub
Call Pct_einf(Range("B4"))
End Sub
Sub Pct_einf(Target As Range)
Dim objShp As Object
Dim shp As Shape
Dim strPath As String, strEnd As String
Application.ScreenUpdating = False
strPath = ThisWorkbook.Path & "/" 'Bilderpfad anpassen
strEnd = ".jpg" 'Anpassen
If Dir(strPath & Target & strEnd) = "" Then
    MsgBox "Kein Bild mit der Artikelnummer gefunden", vbCritical, "Vorgang abgebrochen !"
    GoTo Ende
End If
'Alte Bilder löschen
For Each shp In ActiveSheet.Shapes
    If shp.TopLeftCell.Address(0, 0) = "R4" Then _
        shp.Delete
Next
Set objShp = ActiveSheet.Pictures.Insert(strPath & Target & strEnd)
With objShp
    .Left = Range("R4").Left
    .Top = Range("R4").Top
    .Width = 117 'Breite / evtl. anpassen
    .Height = 158 'Höhe / evtl. anpassen
End With
Ende:
Application.ScreenUpdating = True
End Sub

MfG Peter

AW: Ne Alternative

10.01.2006 19:26:03

Enrico

Hallo Peter
Ist einfach megamässig deine Lösung. Hat alles soweit funktioniert. Nur noch ein kleiner Schönheitsfehler.
Wenn ich die Artikelnummer eingebe und mit enter weitergehe, wird das Bild noch nicht angezeigt. Ich muss nochmals auf die Zelle mit der Artikelnummer klicken und erst dann gehts.
Hast du da eventuell eine Lösung ?
Aber echt... Hat mich riesig gefreut!
Vielen Dank
Enrico

Beliebteste Forumthreads (12 Monate)

Grafik mit Zellwert vergleichen und einfügen

Forumthread: Grafik mit Zellwert vergleichen und einfügen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread