Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
716to720
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
716to720
716to720
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Grafik mit Zellwert vergleichen und einfügen

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
Anzeige
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige