Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1864to1868
1864to1868
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Grafiken per SVerweis kopieren

Forumthread: Grafiken per SVerweis kopieren

Grafiken per SVerweis kopieren
07.01.2022 09:08:24
Edgar
Hallo,
ich tüftele schon seit ein paar Tage an einem Problem(für mich) was ich nicht lösen kann und zu dem ich auch keine geeigneten Posts finden konnt.
Gegeben ist ein WB mit zwei WS.
1. WS Darauf sind vernüpfte Grafiken (Vereinslogos der Bundesligavereine), Vereinsname abgekürzt und Vereinsname
2. WS Ein Spieltag der Bundesliga
In Zeile 3 stehen die Paarungen (mit Abkürzung des Vereinsnamens
Ich möchte nun in Zeile 2 das entsprechende Vereinslogo zu dem Verein einfügen.
Da die Saison ja 34 Spieltage hat würde ich das gerne mit einem SVerweis lösen
Bsp.: SPIELE! B2 = sverweis(b3;VEREINE!$B$3:$C$21;2;FALSCH)
Als Ergebnis bekomme ich aber immer eine 0
Hinweis: Ich dachte eigentlich an eine EXCEL Lösung. Wenn das Ganze aber nur in VBA zu realisieren ist würde ich mich auch über eine solche Lösung freuen
https://www.herber.de/bbs/user/150220.xlsx
Anzeige

18
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: google mal, da solltest Du fündig werden owT
07.01.2022 09:12:43
neopa
Gruß Werner
.. , - ...
AW: Grafiken per SVerweis kopieren
07.01.2022 10:18:31
Edgar
Hallo,
danke erst einmal für Eure Unterstützung.
Auf der Seite die verlinkt ist finde ich zwei Lösungsvarianten. Die Eine nutzt den Namensmanager, die andere eine "Kauflösung" IMAGE-XLS.
Kauflösung kommt überhaupt nicht in Frage und die zweite Variante scheint ja recht statisch zu sein.
Während einer Saison habe ich ja 34 Spieltage x 9 Paarunen x 2 Mannschaften = 612 Vereinslogos
Anzeige
AW: Grafiken per SVerweis kopieren
07.01.2022 10:31:08
SF
Wie kommst du auf 612 Logos?
Wenn du das für ein Logo gemacht hast, kannst du das in der Datei an jeder beliebigen Stelle abfragen.
AW: Grafiken per SVerweis kopieren
07.01.2022 10:39:37
Edgar
Habe mir gerade ein anderes youtube Video angesehen.
Das mit dem Namensmanager kenne ich nicht und muss mich da einml reinfuchsen.
612 deswegen weil ich doch pro Spieltag 18 Manschaften habe die immer unterschiedlich gegeneinander spielen.
Klar habe ich nur 18 Vereinslogos.
Wenn aber z.B. der BVB am 1. Spieltag in Paarung 5 Heimrecht hat und am 2. Spieltag in Paarung 1 Gast ist muss das Logo doch auch an unterschiedlichen Stellen stehen.
Daher mein Gedanke mit dem SVerweis
Anzeige
AW: Grafiken per SVerweis kopieren
07.01.2022 10:45:10
SF
Der Sverweis ist ja schon richtig. Und wenn du zu jeder Mannschaft das Logo haben willst musst du natürlich 612 Sverweise schreiben, bzw. von Excel schreiben lassen.
AW: Grafiken per SVerweis kopieren
07.01.2022 11:20:40
Edgar
Ja, und im Namensmanager ist ja ein Bezug auf das Arbeitsblatt enthalten. Da ich pro Spieltag ein Arbeitsblatt habe muss ich dann ja auch entsprechend viele Einträge im Namensmanager vornehmen.
SVerweise lönnte ich kopieren. Ich weiß nur nicht wie ich auf die Grafik verweisen kann. Normal verweise ich doch auf die Zelle/Zellen. Und da steht ja nichts drin.
Anzeige
AW: Grafiken per SVerweis kopieren
07.01.2022 11:48:29
SF
Stimmt, hatte ich nicht bedacht.
Ich schau mal ob mir eine Lösung dazu einfällt.
AW: Grafiken per SVerweis kopieren
07.01.2022 12:03:21
Edgar
Anscheinend geht der SVerweis tatsächlich nur auf Zellinhalte.
Wenn ich wüsste wie man ein Bild aus einem Verezichniss kopieren kann wäre auch unter VBA Folgendes denkbar:
1. Tabelle mit allen Vereinsabkürzungen
2. Dann auf dem WS Spieltag in der Zelle über dem Verein
select case true
case ws.range("B2").value. = ws(Bilder).range("B2").value
insert Bild1
case ws.range("B2").value. = ws(Bilder).range("B3").value
insert Bild2
u.s.w.
end select
Anzeige
AW: Grafiken per SVerweis kopieren
07.01.2022 12:10:51
Herbert_Grom
Hallo Edgar,
gib doch jedem Logo einen eigenen Namen. Dann kannst du sie alle in einem AB ablegen und mit Copy & Paste an jeder beliebigen Stelle einfügen. Wenn ich dich richtig verstanden habe.
Servus
AW: Grafiken per SVerweis kopieren
07.01.2022 12:42:13
Herbert_Grom
Schau dir mal meinen Vorschlag an:
https://www.herber.de/bbs/user/150228.xlsm
Servus
Anzeige
AW: Grafiken per SVerweis kopieren
07.01.2022 17:25:48
Edgar
Genau so möchte ich das haben. Nur halt keine Schaltfläche sondern bei WS.Activate.
Aber das sollte kein Problem sein.
Ist das Modul 1 des Rätsels Lösung? Das ist ja unglaublich. Und vor allem kann ich das so über eine schleife laufen lassen.
Du wirst es nicht glauben: Ich sitze seit Tagen an dem Thema und habe unzählige Artikel gelesen. Manchmal mit Lösungsvorschlägen mit 50 Zeilen Code. Aber nie das was ich genau gesucht habe.
Du bist mein Held 2022! Danke!
Anzeige
AW: Grafiken per SVerweis kopieren
07.01.2022 17:57:28
Edgar
Ich muss noch einmal etwas nachfragen:
Habe Deine Lösung eingebaut unter WS activate. Funktioniert super!
Wenn ich jetzt das WS erneut aufrufe werden die Logos ebenfalls erneut kopiert
Kann ich vor dem Kopieren alle Logos des WS löschen wenn vorhanden?
AW: Grafiken per SVerweis kopieren
07.01.2022 17:16:08
Edgar
Hallo,
nein, so einfach ist es nicht:
Beispiele
1. Spieltag 1. Spiel Bayern gegen Dortmund
2. Spieltag 1. Spiel Wolfsburg gegen Bayern
Auf dem WS sieht das in etwa so aus
FCB : BVB WOB . FCB
Oben drüber mochte ich jetzt das Vereinslogo einblenden. Ich habe pro Manschaft ein Vereinslogo. Die Paarungen der Spieltage sind dynamisch
Anzeige
AW: Grafiken per SVerweis kopieren
08.01.2022 08:44:43
Edgar
Bevor ich die Logos kopiere lösche ich ggf. Vorhandene erst einmal damit:

Public Sub LogosDelete()
Dim i As Integer
Dim BC As Shape
For Each BC In ActiveSheet.Shapes
BC.Delete
Next BC
End Sub
Leider werden auch CheckBoxen gelöscht. Kann ich das verhindern? Z.B. das ich die Range wo sich die Logos befinden einschränke? Oder gibt es eine bessere Methode? Bie Namen der Logos sind bekannt.
Anzeige
AW: Grafiken per SVerweis kopieren
08.01.2022 09:09:58
Nepumuk
Hallo Edgar,
so löschst du ein Shape dessen obere linke Ecke in Zelle A1 liegt:

Public Sub LogosDelete()
Dim objShape As Shape
For Each objShape In ActiveSheet.Shapes
If Not Intersect(objShape.TopLeftCell, Range("A1")) Is Nothing Then Call objShape.Delete
Next
End Sub
Gruß
Nepumuk
Anzeige
AW: Grafiken per SVerweis kopieren
08.01.2022 12:41:39
Edgar
Meine Logos sind immer in Reihe 2, Spalten B,C,E,F,H,I,K,L,N,O,Q,R,T,U,W,X,Z,AA
Ich habe das jetzt so in Deiner Lösung eingebaut

Public Sub LogosDelete()
Dim objShape As Shape
For Each objShape In ActiveSheet.Shapes
If Not Intersect(objShape.TopLeftCell, Range("B2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("C2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("E2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("F2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("H2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("I2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("K2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("L2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("N2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("O2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("Q2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("R2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("T2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("U2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("W2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("X2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("Z2")) Is Nothing Then Call objShape.Delete
If Not Intersect(objShape.TopLeftCell, Range("AA2")) Is Nothing Then Call objShape.Delete
Next
End Sub
Da kommt dann immer ein Laufzeitfehler 104 - Anwendungs.- oder objektdefinierter Fehler
beim ersten Shape was vorhanden ist
Anzeige
AW: Grafiken per SVerweis kopieren
08.01.2022 12:50:16
Edgar
Ich habe das jetzt so gelöst das für jede Zelle (insgesamt 18) ein For Schleife nach Deinem Beispiel durchlaufen wird. Damit funktioniert es. Und auch die CheckBoxen bleiben erhalten :)

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige