Grafik dynamisch einfügen

Forumthread: Grafik dynamisch einfügen

31.05.2014 17:52:30

phil

Hallo und guten Tag,
Ich (ein absoluter Anfänger was Excel und VBA angeht) habe ein Problem bei einem Projekt von mir. Ich möchte gerne ein Angebotstool mit Excel erstellen das es ermöglicht mit Hilfe von einer Eingabemaske schnell und einfach ein Angebot zu erstellen.
Ich bin soweit auch fertig damit versuche nun allerdings schon seit 3 Wochen eine Lösung für mein derzeitiges Problem zu finden. Und zwar möchte ich in meinem Angebot auch Bilder einfügen. Ich habe einmal eine Beispieldatei angehangen, in der man die derzeitige Funktionalität sehen kann.
Ich möchte gerne Bilder zu den einzelnen Produkten im Tabellenblatt Komponenten hinterlegen (Spalte Bild), welche dann in eine bestimmte Zeile ins Angebot kopiert werden sollen, wenn die jeweilige Komponente ausgewählt wurde. Ich hoffe es wird klar was ich meine durch die Beispieldatei.
Im Angebot werden die Zellen die mit Delete beschriftet sind weil das jeweilige Produkt nicht angeklickt wurde über VBA im bisher vorletzten Schritt über einen Button gelöscht!
Ich bin mir nicht sicher in welchem Schritt es am einfachsten wäre die Bilder einzufügen. Soweit wie ich es bis jetzt verstanden habe, wäre es am einfachsten, wenn ich die Bilder im letzten Schritt einfüge, also, nachdem die Zeilen, in denen nur Delete steht, weil die Komponente nicht ausgewählt wurde, gelöscht werden. Das könnte dann hoffentlich irgendwie über einen Sverweis anhand des Komponentennamens passieren. Leider weiß ich aber überhaupt nicht (auch nach nun mehreren Tagen Internetrecherche) wie ich es schaffe das die Bilder von den jeweiligen Komponenten in der richtigen Spalte und Zeile vom Angebot eingefügt werden können (automatisch). Ich hoffe sehr das hier jemand eine Idee hat.
Ich bedanke mich bereits im voraus und verbleibe
mit freundlichen Grüßen
Phil
https://www.herber.de/bbs/user/90932.xlsm

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Grafik dynamisch einfügen

01.06.2014 11:28:12

phil
AW: Grafik dynamisch einfügen

02.06.2014 14:26:15

fcs

AW: Grafik dynamisch einfügen

02.06.2014 14:26:15

fcs

Hallo Phil,
ich würde an deiner Stelle die Bilder als jpg-Dateien in einem Unterverzeichnis der Angebotsmaster-Datei speichern. Zur schnellen Anzeige eines Komponentenbildes könnte man per Formel in Spalte G in jeder Zeile einen Hyperlink generieren.
Nachdem die nicht erforderlichen Zeilen gelöscht sind holt das Erstellen-Makro dann die Grafiken in die entsprechende Zeile und passt bei Bedarf die Größe an die Spaltenbreite an und vergrößert falls erforderlich die Zeilenhöhe.
Grundsätzlich könnte man auch etwas ähnliches machen wenn die Bilder im Blatt Komponenten vorhanden sind. Dann würden die entsprechenden Bilder vom Blatt Komponenten ins Blatt Angebot kopiert. Aber:
1. Die Datei wird bei entsprechend vielen Grafiken relativ groß.
2. Die Pflege der Daten im Blatt Komponenten ist mit vielen Abbildungen nicht sehr komfortabel.
3. Ein versehentliches Verschieben von Grafiken kann die Zuordnung durcheinander bringen.
Gruß
Franz

Public Sub CommandButton1_Click()
On Error GoTo Fehler
Dim c As Range
Dim SrchRng As Range
Dim i As Long
Dim objShape As Shape
Dim varArtikel, varBild
Dim d As Range
For i = 1 To 2
Set SrchRng = Sheet4.Range("B35", ActiveSheet.Range("B245").End(xlUp))
Do
Set c = SrchRng.Find("delete", LookIn:=xlValues)
If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
Next i
Set SrchRng = Sheet4.Range("B35", ActiveSheet.Range("B245").End(xlUp))
Do
Set d = SrchRng.Find("delete", LookIn:=xlValues)
If Not d Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
'Bilder einfügen in Spalte D
With Sheet4 'Angebot
.Activate
'vorhandene Bilder unterhalb Zeile 34 löschen
For Each objShape In .Shapes
i = objShape.TopLeftCell.Row
If i >= 34 Then objShape.Delete
Next
'ggf. Zeilenhöhe per Autofit anpassen
If i > 34 Then
.Range(.Rows(35), .Rows(i)).AutoFit
End If
'Zeilen abarbeiten und Bilder aus Datei einfügen.
For i = 35 To .Cells(.Rows.Count, 1).End(xlUp).Row - 5
varArtikel = .Cells(i, 2).Text
varBild = .Cells(i, 4).Text
If varBild  "" Then
'Dateiname des Bildes berechnen
varBild = ThisWorkbook.Path & "\Bilder\" & varBild & ".jpg"
'kontrolle ob Bild vorhanden
If Dir(varBild) = "" Then
MsgBox "Datei """ & varBild & ".jpg"" für Artikel """ & varArtikel _
& """ nicht gefunden!"
Else
.Cells(i, 4).Select
.Pictures.Insert(varBild).Select
Set objShape = .Shapes(.Shapes.Count)
objShape.LockAspectRatio = msoTrue
If objShape.Width > .Cells(i, 4).Width - 4 Then
objShape.Width = .Cells(i, 4).Width - 4
End If
If .Rows(i).RowHeight

Infobox / Tutorial