online 1
gast (50)

/ Forum / Tabellenkalkulation

TabellenkalkulationTabellenkalkulation

Fragevon HRD vom 04.11.2020, 08:36 Options

Lösung

Bild bei Excel-Befehl einfügen

Hallo Leute,

als absoluter VBA-Dummie muss ich mich trotzdem damit befassen und hoffe nun, dass sich jemand hier meine Sorgen anhört.
Ich suche eine Lösung, ähnlich wie Fragenboy sie hier gesucht hat: http://www.supportnet.de/threads/1440328

Allerdings definiere ich über eine Formel in Tabelle 1, welches Bild (JPG) gewählt werden soll. Insgesamt sind es 5 verschiedene Bilder, die je nach Formelergebnis dann in einer definierten Zelle in Tabelle 2 angezeigt werden sollen. (Also ala "Wenn TabelleA1=1 Dann Bild1 / Wenn TabelleA1=2 dann Bild2" etc.) Die Bilder liegen auf einem Netzlaufwerk und sind ber+eits in der richtigen Grösse formatiert.

Hat jemand einen Tip, wie ich das Script von Coros umbauen muss, damit das funzt? Evtl. auch mit einem Hinweis, wie ich später bei Bedarf weitere Zellen abfragen und weitere Bilder einbinden kann?

Allerherzlichsten Dank!
Daniel


Antwort schreiben

Antwort 1 von coros vom 04.11.2020, 12:52 Options

Hallo Daniel,

das könnte z.B. folgendermaßen aussehen. Bei dem Code wird, sofern in Zelle A1 etwas eingetragen wird, das Bild eingefügt.
In dem Code muss der Pfad, der hinter "Const Pfad =" steht angepasst werden.

Kopiere das Makro in das VBA-Projekt des Tabellenblatts, in dem er wirken soll.
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Const Pfad = "C:\Eigene Dateien\"

Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") <> "" Then
Range("A1").Activate
ActiveSheet.Pictures.Insert(Pfad & Range("A1") & ".jpg").Name = "Bild"
Else
ActiveSheet.Shapes("Bild").Delete
End If
End Sub


Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

Bei Fragen melde Dich.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 2 von HRD vom 04.11.2020, 15:11 Options

Hallo Coros,

vielen Dank für Deine Hilfe, das sieht schon sehr vielversprechend aus, werde es möglichst heute noch ausführlich testen.
Noch zwei Fragen, bevor ich meinen Rechner quäle:
- So wie ich das verstehe, prüft das Makro mit <>, ob etwas in der Zelle drinsteht; meine Formel liefert den Wert 0, wenn kein Bild erscheinen soll, deshalb soll nur bei einem Wert >0 eine Aktion ausgeführt werden. (es gibt keine Werte <0) Wie mach ich das?
- Wie erreiche ich, dass immer zu Beginn des Makros das Bild gelöscht wird (so dass die Zelle leer ist, wenn der Wert 0 ist)?

Nochmals vielen Dank für Deine Hilfe!

Gruss
Daniel

Antwort 3 von HRD vom 04.11.2020, 16:08 Options

Hallo Oliver,

hab nun mal einen Test gemacht; leider krieg ich aber eine Fehlermeldung "Laufzeitfehler 1004 - Die Insert-Eigenschaft des Pictures-Objekts kann nicht zugeordnet werden"
Im VBA-Fenster wird dann die Zeile
"ActiveSheet.Pictures.Insert(Pfad & Range("A1") & ".tif").Name = "Bild"
gelb markiert...

(die Bilder liegen im angegebenen Pfad, sind aber TIF; hab ich so angepasst)

Hast Du einen guten Rat?

Danke & Gruss
Daniel

Antwort 4 von coros vom 04.11.2020, 19:22 Options

Hallo Daniel.

damit die Prozedur mit derm von Dir angesprochenen Wert funktioniert, müsste der Code wie folgt aussehen:

Option Explicit

Const Pfad = "C:\Eigene Dateien\"

Sub Worksheet_Change(ByVal Target As Range)
If Range("A1") > 0 Then
Range("A1").Activate
ActiveSheet.Pictures.Insert(Pfad & Range("A1") & ".jpg").Name = "Bild"
Else
ActiveSheet.Shapes("Bild").Delete
End If
End Sub


Bezüglich des Laufzeitfehlers müsste man Deine Datei haben, da es dafür mehrere Gründe haben kann. Eventuell lädst Du die ja mal über eine entsprechende Internetseite, z.B. über http://www.netupload.de/ hoch, damit man sich die Datei mal ansehen kann.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 5 von HRD vom 05.11.2020, 06:57 Options

Hallo Oliver,

hier findest Du das File:
http://www.materialordner.de/Oag3yW03kJMQllCBrTRXGIsOz5oXeWz.html (mit dem neuesten Code und einem anderen Versuch)

Sorry, wenn ich jetzt gleich nerve:
Bei Deinem Code wird offenbar das Bild in Zelle A1 eingefügt; wie definiere ich eine andere Ausgabeposition?
Und wie erreiche ich, dass beim Makro-Start die Bilder gelöscht werden? (Die Ausgabe erfolgt in einer Grafik mit Hintergrundbild, deshalb verwende ich transparente GIF-Bilder; wenn der Eingabewert 0 ist, soll deshalb das "alte" Bild gelöscht werden.

Nochmals vielen Dank für Deine Bemühungen!!

Gruss
Daniel

Antwort 6 von coros vom 05.11.2020, 08:59 OptionsLösung

Lösung
Hallo Daniel,

die Datei, die Du hochgeladen hast ist meiner Meinung nach nicht die Datei, mit der Du wirklich arbeitest. Den dort wird nirgends der Bidlname mittels einer Formel vorgegeben, wie Du es in AW4 geschreiben hast.
Bei mir funktioniert die hochgeladnene Beispieldatei jedenfalls ohne Probleme.

Für die Angabe einer anderen Zelle, an der das Bild ausgerichtet werden soll, muss die Zeile

Range("A2").Activate

angepasst werden. Einfach die Zellbezeichnung A2 ändern

Zum Löschen eines Bildes muss der Delete-Befehl am Anfang des VBA-Codes ausgeführt werden. Der COde sieht dann wie folgt aus.

Option Explicit

Const Pfad = "C:\Temp\Projekt99\"

Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Shapes("Bild").Delete
If Range("A2") > 0 Then
    Range("A2").Activate
    ActiveSheet.Pictures.Insert(Pfad & Range("A2") & ".tif").Name = "Bild"
End If
On Error GoTo 0
End Sub

Ich hoffe, Du meintest das so?

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 7 von HRD vom 05.11.2020, 10:07 Options

Hallo Oliver,

die Formel, die mir den Wert für das Bild liefert, ist recht komplex und steht in einem anderen Excel-File. Der Input über die Formel hat aber soweit geklappt mit dem alten Code in der 1.Mappe, darum habe ich die Formel gelöscht.

Den neuen Code von Dir hab ich getestet; da kriege ich nun keine Fehlermeldung mehr, allerdings auch kein Bild.
Das ist aber alles halb so wild, ich hab mal gebastelt und einige Teile aus dem neuen Code in den alten gepackt (Trial and Error), und schlussendlich habe ich gekriegt was ich suchte. (Sicher, wer sich mit VBA auskennt könnte das eleganter lösen, aber für meinen Bedarf reicht es vollkommen)

Also, somit hast Du alle meine Wünsche zu meiner vollsten Zufriedenheit erfüllt; Du kriegst die volle Punktzahl.

Vielen vielen Dank für Deine Bemühungen und Deinen Support!!

Beste Grüsse
Daniel

Antwort 8 von coros vom 05.11.2020, 10:13 Options

Hallo Daniel,

freut mich, dass Du etwas brauchbares aus dem VBA-Code verwenden konntest. Danke auch für die Rückmeldung.

MfG,
Oliver
Jeder macht was er will, keiner macht was er soll, aber alle machen mit.

Antwort 9 von HRD vom 05.11.2020, 10:17 Options

So, und zum Schluss noch meine Lösung (falls mal jemand was ähnliches braucht):
(Verbesserungsvorschläge werden natürlich gerne angenommen)

1. Die Bilder liegen im angegebenen Laufwerk (TIF)
2. Dateinamen: 1000.tif / 2000.tif etc.
3. Die Bildnummer wird z.B. aus einer Formel in die Zelle G9 übergeben
4. Bevor ein neues Bild eingefügt wird, wird das alte gelöscht
5. Bei einem Wert 0 wird kein Bild angezeigt
6. Die Bilder werden in der Zelle G15 eingefügt

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Shapes("Bild").Delete

If Range("G9") = 1 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\1000.gif").Name = "Bild"
ElseIf Range("G9") = 2 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\2000.gif").Name = "Bild"

ElseIf Range("G9") = 3 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\3000.gif").Name = "Bild"

ElseIf Range("G9") = 4 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\4000.gif").Name = "Bild"
ElseIf Range("G9") = 5 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\5000.gif").Name = "Bild"
End If
On Error GoTo 0
End Sub

Antwort 10 von HRD vom 06.11.2020, 07:07 Options

Ich bin wieder daaaa!

Tja Freunde des Longdrinks, hab mich zu früh gefreut... Hab gedacht so schwer kann das ja nicht sein, von nun an kriegst du das alleine hin... Falsch gedacht!
Der obige Code funktioniert zwar für einen einzelnen Wert und die Bilder dazu, aber meine Anwendung ist noch etwas komplexer:

Ich möchte mehrere Zellen abfragen und entsprechend die Bilder laden, also ala
Wenn Zelle A1 = 1 dann Bild 1 in Zelle B1
Wenn Zelle A1 = 2 dann Bild 2 in Zelle B1
...
Wenn Zelle A2 = 1 dann Bild 1 in Zelle B2
Wenn Zelle A2 = 5 dann Bild 5 in Zelle B2 etc.

Ich habe den obigen Code mehrfach untereinander kopiert und die Zelldefinitionen entsprechend angepasst, aber nun wird nur noch das letzte Bild eingefügt. (wie ganz am Anfang gesagt, von VBA hab ich Null Ahnung und probiere einfach mal drauflos!)
--> die Bildnamen müssen nicht unbedingt zusammengesetzt werden, die habe ich klar definiert und die ändern sich auch nicht. Es sind immer die gleichen Bilder, die je nach Input ausgegeben weden, dies aber mehrfach und jeweils abhängig von anderen Eingabewerten.

Hat da jemand einen heissen Tip?

Noch einmal vielen herzlichenDank für Eure Bemühungen

Antwort 11 von coros vom 06.11.2020, 08:07 Options

Hallo Daniel,

wo ist Dein Makro, so wie es im Moment bei Dir in der Datei vorhanden ist? Ohne dieses Makro kann keine Hilfestellung gegeben werden.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 12 von HRD vom 06.11.2020, 08:13 Options

Hallo Oliver,

sorry, hier ist es:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Shapes("Bild").Delete

If Range("G9") = 1 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\1000.gif").Name = "Bild"
ElseIf Range("G9") = 2 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\2000.gif").Name = "Bild"

ElseIf Range("G9") = 3 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\3000.gif").Name = "Bild"

ElseIf Range("G9") = 4 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\4000.gif").Name = "Bild"
ElseIf Range("G9") = 5 Then
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        "C:\Temp\Projekt99\5000.gif").Name = "Bild"
End If
On Error GoTo 0
End Sub


Danke & Gruss
Daniel

Antwort 13 von coros vom 06.11.2020, 08:26 Options

Hallo Daniel,

versuche mal den nachfolgenden Code. Hier wird nicht mit einer Abfrage gearbeitet, sondern mit einer Case-Anweisung. Diese ersetzt die Abfrage und ist übersichtlicher, wenn man mehrere verschiedene Kriterien hat.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strPfad As String

strPfad = "C:\Temp\Projekt99\"

Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Shapes("Bild").Delete

Select Case Range("G9")

Case 1
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        strPfad & "1000.gif").Name = "Bild"

Case 2
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        strPfad & "2000.gif").Name = "Bild"
 
Case 3
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        strPfad & "3000.gif").Name = "Bild"

Case 4
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        strPfad & "4000.gif").Name = "Bild"

Case 5
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        strPfad & "5000.gif").Name = "Bild"
        
End Select
On Error GoTo 0

End Sub


Die Zahl hinter "Case" ist immer das Kriterium, bei dem etwas ausgeführt werden soll. Bei Dir also die Zahlen 1, 2, 3, 4 und 5. Möchtest Du nun eventuell nocht das bei der Zahl 6 etwas ausgeführt wird, kopiere die Case-Anweisung (Immer nur von einer Case-Anweisung bis zu nächsten, also z.B. von Case 1 bis Case 2 kopieren) und ändere die Zahl hinter "Case" in 6 und passe die Befehle darunter an.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 14 von HRD vom 06.11.2020, 08:37 Options

Hallo Oliver,

prima, das funktioniert für einen Wert und die entsprechenden Bilder.
Nun der 2.Teil: Wie frage ich im gleichen Durchlauf eine 2. Zelle mit einem anderen Wert ab und gebe das Bild an einer anderen Position aus?

Vielen Dank!
Daniel

Antwort 15 von coros vom 06.11.2020, 09:27 Options

Hallo Daniel,

wieder mit

Select Case Range("G9")

Case xyz
'hier dann das was ausgeführt werden soll
        
End Select

Anstelle G9 muss dort natürlich die Zellbezeichnung eingetragen werden, in der die Zahlen eingegeben werden.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 16 von HRD vom 06.11.2020, 10:05 Options

Jaaaah!

Mein Problem ist zu 99.99% gelöst!!

Nun (hoffentlich) die letzte schüchterne Frage:
Wie erreiche ich, dass jedes Mal, bevor das Makro die Eingabezelle abfragt, zuerst das aktive Bild gelöscht wird?


Ich hab vesucht, unter jeder Case-Anweisung den Löschbefehl einzubauen, (siehe unten) aber dann klappt es nicht mehr (es wird nur noch der letzte Case-Block ausgeführt)

(Aussschnitt)
Case 1
ActiveSheet.Shapes("Bild").Delete
Range("G15").Activate
ActiveSheet.Pictures.Insert( _
        strPfad & "1000.gif").Name = "Bild"


Wäre es evtl. eine Idee, in einem separaten Makro alle Bilder der Arbeitsmappe zu löschen, bevor das Einfüge-Makro läuft?

Die Eingabe der Werte erfolgt ja in einer anderen Mappe, und wenn alle Werte eingegeben sind, wechsle ich in die Mappe, in der die Bilder eingefügt werden; zur Eingabe neuer Werte wechsle ich wieder in die Mappe 1, danach schaue ich mir das Ergebnis in Mappe 2 an.
So gesehen, das Einfügemakro müsste jedesmal gestartet werden, wenn die Mappe 2 aufgefufen wird. (oder, wenn das einfacher geht, wenn einer der Werte in einem bestimmten Zellbereich geändert wird)

(Sorry, wahrscheinlich hätte ich Dir eine Menge Arbeit erspart, wenn ich das gleich zu Beginn gesagt hätte.... tut mir wirklich leid!)

Antwort 17 von coros vom 06.11.2020, 10:19 Options

Hallo Daniel,

Du musst ein anderen Namen für das Bild vergeben. Anstelle "Bild" nenne es z.B. "Bild1". Diesen Namen vergibst Du dann an das eingefügte Bild in deiner 2. Case-Anweisung.

Am Anfang des VBA-Codes musst Du dann noch unter der 1. Delete-Anweisung eine 2. Delete-Anweisung schreiben, die Dir das Bild mit dem Namen "Bild1" löscht. Das müsste dann so aussehen:

ActiveSheet.Shapes("Bild1").Delete

So sollte es funktionieren. Wenn nicht oder wenn ich Dich falsch verstanden habe, melde Dich.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 18 von HRD vom 06.11.2020, 10:35 Options

Hallo Oliver,

jetzt kommen wir der Sache schon seeeehr seeeehr nahe!
Wenn ich die Zahlen in der Tabelle eingebe, in der auch die Bilder stehen sollen, klappt es wunderbar, nur die Übergabe aus der anderen Tabelle, in der die Berechnungen erfolgen, klappt noch nicht.
Weisst Du da auch noch einen Rat?

(wie gesagt, ein Befehl der das Makro startet, sobald die Tabelle aufgerufen wird, würde das Problem vielleicht lösen)

Vielen vielen Dank! Ich überleg mir noch, wie ich Dir wirklich danken kann (nicht bloss mit Worten!)

Antwort 19 von coros vom 06.11.2020, 10:55 Options

Hallo Daniel,

damit etwas ausgeführt wird, sobal ein Blatt aktiviert wird, also aufgerufen wird, muss der VBA-Code in dem "Private Sub Worksheet_Activate()-Ereignis" stehen.
Schau mal am oberen Rand des Fensters, in dem Du bis jetzt den VBA-Code eingetragen bzw. geändert hast nach. Dort befinden sich 2 ComboBoxen (DropDown-Menüs). In der linken müsste "Worksheet" stehen. Bei der rechten klicke mal auf den Pfeil und wähle "Activate". Es wird automatisch der Start und Endpunkt eingetragen. Kopiere dazwischen nun den gesamten Code aus Deiner vorhandenen Anweisung. Aber bitte nur das kopieren, was hinter "Private Sub Worksheet_Change(ByVal Target As Range)" und vor "End Sub" steht.
Danach sollte der gesamte Code auch ausgeführt werden, sobald Du auf das Blatt wechselst.

MfG,
Oliver
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 20 von HRD vom 06.11.2020, 11:07 Options

YES!!!!

Oliver, Du bist mein Held!
Wäre ich Dein Chef, würde ich Dich sofort eine Woche in den Urlaub schicken!

Vielen, vielen, vielen herzlichen Dank!!!!

Gruss
Daniel

Ähnliche Themen

Bild über Hilfs-Tabelle per Option einfügen.
bokap1975  10.08.2007 - 6 Hits - 2 Antworten

Excel Bild in Zelle einfügen
Gorrif  18.11.2007 - 1475 Hits - 9 Antworten

Excel-Befehl Zählenwenn für mehrere Tabellenblätter
Reu  24.08.2008 - 201 Hits - 7 Antworten

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..

Neue Einträge

Version: supportware 1.9.150 / 10.06.2022, Startzeit:Mon Jan 26 16:59:01 2026