Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Bild aus einem Arbeitsblatt per Formel holen???





Frage

Bild aus einem Arbeitsblatt per Formel holen??? Hallo Ihr guten Geister dieses tollen Forums, vieleicht kann mir jemand bei meinem Problem helfen. Ich habe eine Tabelle mit mehreren Arbeitsblättern. In einem Arbeitsblatt (dieses Blatt heißt auch Daten) sind meine Daten die dann auf die einzelnen Blätter verteilt werden. Nun brauche ich aber 4 verschiedene Bilder die bei den Arbeitsblättern wechselweise gebraucht werden. Wenn also in dem Datenblatt ein bestimmter Name verwendet wird soll das dazugehörige Bild dann auf die Arbeitsblätter verteilt werden. z.B.: Name "W" enspricht Bild "W" Name "X" enspricht Bild "X" Name "Y" enspricht Bild "Y" Name "Z" enspricht Bild "Z" Gibt es dafür eine Einfache Lösung per Formel. Das Problem ist das ich die Bilder nicht an eine Zelle binden kann. Oder geht das doch irgendwie? Die Bilder sollen auch in dem "Daten"-blatt zu sehen sein und von dort in die anderen Blätter eingefügt werden! Bitte helft mir. Vielen Dank im voraus. Gruß Karsten

Antwort 1 von coros

Hi Karsten,

mit einer Formel kannst Du das nicht lösen. Das geht nur via eiens VBA Codes. Dazu benötigt man aber ein paar mehr Infos. Man müsste wissen, wie die Bilder heißen, wo genau sie liegen (in gleicher Datei oder anderer Datei) und das Ereignis, wann welches Bild eingeblendet werden soll. Wenn man diese Infos hat, kann man daraus einen VBA Code erstellen, der das machen sollte, was Du möchtest.

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 kvtv

Hi Oliver "Coros", vielen Dank für deine schnelle Antwort. In dem Tabellenblatt "Daten!C17" möchte ich einen Namen, von 2 möglichen, aus einem Auswahlmenü (wie das geht weiß ich leider auch nicht, wäre auch hier für eine kleine Hilfe Dankbar) auswählen. Nehmen wir einmal an, daß bei dem

Blatt "Daten!C17" "Name1" steht.
Dann soll in das Blatt "Deckblatt!C23" "Bild1a.jpg" und in das Blatt "GV-Erträge!M38" das "Bild1b.jpg" eingefügt werden.
Steht aber in dem Blatt "Daten!C17" "Name2",
dann soll in das Blatt "Deckblatt!C23" das "Bild2a.jpg" und in das Blatt "GV-Erträge!M38" das "Bild2b.jpg" eingefügt werden.
Die Bilder sollen im selben Verzeichnis wie die Tabelle selbst sein.
Die bilder sollen folgende Größe haben:

Bild1a.jpg=
Skalierung Höhe 92% x Breite 80% oder
Höhe 3,02cm x Breite 6,4cm und
Anordnung in der Zelle oben links.

Bild1b.jpg=
Skalierung Höhe 85% x Breite 80% oder
Höhe 4,5cm x Breite 4,26cm und
Anordnung in der Zelle unten rechts.

Bild2a.jpg=
Skalierung Höhe 15% x Breite 15% oder
Höhe 2,43cm x Breite 5,34cm und
Anordnung in der Zelle oben links.

Bild2b.jpg=
Skalierung Höhe 87% x Breite 80% oder
Höhe 4,1cm x Breite 4,07cm und
Anordnung in der Zelle unten rechts.

Ich hoffe das ich mich verständlich ausgedrückt habe.
Vielen Dank im voraus.
Gruß Karsten

Antwort 3 von coros

Hi Karsten,

mit nachfolgendem Makro werden Dir je nach dem welcher Name in Tabellenblatt „Daten“ in Zelle C17 eingegeben wird 2 verschiedenen Bilder in Blatt „Deckblatt“ Zelle C23 und Blatt „GV-Erträge“ Zelle M38 eingefügt. Kopiere den Code in das VBA Projekt des Tabellenblattes „Daten“.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Objekt As Object, Wiederholungen As Integer
Application.ScreenUpdating = False
If Target.Cells.Address = "$C$17" Then
For Wiederholungen = 1 To Worksheets.Count
If Sheets(Wiederholungen).Name <> "Daten" Then
Sheets(Wiederholungen).Activate
For Each Objekt In ActiveSheet.Shapes
If Mid(Objekt.Name, 1, 7) = "Picture" Then
Objekt.Delete
End If
Next
End If
Next
Select Case Sheets("Daten").Range("C17")
Rem: 1. Name
Case "Name1"
Sheets("Deckblatt").Activate
Sheets("Deckblatt").Range("C23").Select
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild1.jpg").Select
With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 85.5
    .ShapeRange.Width = 181.5
End With
Sheets("GV-Erträge").Activate
Sheets("GV-Erträge").Range("M38").Select
Sheets("GV-Erträge").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild1.jpg").Select
With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 127.5
    .ShapeRange.Width = 120.75
    .ShapeRange.Left = 500
    .ShapeRange.Top = 200
End With
Sheets("Daten").Activate
Rem: 2. Name
Case "Name2"
Sheets("Deckblatt").Activate
Sheets("Deckblatt").Range("C23").Select
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild2.jpg").Select
With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 69#
    .ShapeRange.Width = 151.5
End With
Sheets("GV-Erträge").Activate
Sheets("GV-Erträge").Range("M38").Select
Sheets("GV-Erträge").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild2.jpg").Select
With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = 116.25
    .ShapeRange.Width = 115.5
    .ShapeRange.Left = 500
    .ShapeRange.Top = 200
End With
Sheets("Daten").Activate
End Select
End If
End Sub

Zunächst werden in beiden Tabellenblätter alle Bilder, die das Wort „Picture“ in ihrem Namen enthalten, gelöscht. Danach wird ausgewertet, welcher Name in Tabellenblatt „Daten“ Zelle C17 eingegeben wurde. Je nach dem Namen wird das Bild „Beispielbild1.jpg“ oder „Beispielbild2.jpg“ eingefügt und an die entsprechende Größe angepasst. In Tabellenblatt „Deckblatt“ wird das Bild oben links zur Zelle ausgerichtet. Auf dem Blatt „GV-Erträge“ muss mit den Werten in den Zeilen

. ShapeRange.Left = 500

und

.ShapeRange.Top = 200

etwas herumexperementiert werden, da man eine Ausrichtung an der unteren rechten Ecke mit einem Objekt nicht vornehmen kann. Der Wert „Left“ sagt den Abstand zum linken Tabellenblattrand und der Wert „Top“ sagt den Wert vom oberen Tabellenblattrand aus. Da das vom Aufbau der Tabelle abhängt, also wie die Zeilenhöhe und die Spaltenbreite in dem Blatt sind, kann man dort keinen Pauschalen Werte angeben, deshalb bitte austesten. Außerdem musst Du noch überall dort wo Beispielbild1.jpg, bzw. Beispielbild2.jpg steht, Dein Bildernamen angeben.

Ich hoffe, Du kommst klar. Bei Fragen melde Dich.

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.

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 4 von kvtv

Hi Oliver,
recht vielen Dank für Deine Bemühungen. Ich finde es ganz toll wie Du Dich um uns kümmerst. Habe allerdings noch ein oder zwei Fragen. Zum einen hast Du glaube ich vergessen das bei "Name1" zwei verschiedene Bilder (Bild1a.jpg und Bild1b.jpg) eingefügt werden sollen und bei "Name2" sollen es auch zwei verschiedene Bilder (Bild2a.jpg und Bild2b.jpg) sein. Falls ich Dein Macro richtig verstanden habe hast Du jeweils nur mit einem Bild gearbeitet. Oder? Bei dem Auszug aus Deinem Macro hier unten ist da vieleicht ein Fehler bei

.ShapeRange.Height = 69#

"=69# "
reingehuscht?
Auszug:

Rem: 2. Name
Case "Name2"
Sheets("Deckblatt").Activate
Sheets("Deckblatt").Range("C23").Select
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild2.jpg").Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 69#
.ShapeRange.Width = 151.5

Wie kann ich denn im Blatt "Daten!C17" aus dieser Zelle eine Auswahlzelle machen wo nur die beiden Namen zur Auswahl stehen und keine andere Eingabe möglich ist. In der Auswahl soll Name1 und Name2 stehen. Ich hoffe ich überlaste Dich nicht mit meinen Problemen. Vielen Dank im voraus.
Gruß Karsten

Antwort 5 von coros

Hi Karsten,

danke Dir für Deine lobenden Worte. Um zusätzlich zwei andere Bilder einzulesen, musst Du in den Zeilen, in denen der Bildname vorkommt, bei dem Blatt, bei dem das neue Bild eingelesen werden soll, den neuen Bildnamen eintragen. Der Code müsste dann für 4 verschiedene Bilder folgendermaßen aussehen.

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim Objekt As Object, Wiederholungen As Integer 
Application.ScreenUpdating = False 
If Target.Cells.Address = "$C$17" Then 
For Wiederholungen = 1 To Worksheets.Count 
If Sheets(Wiederholungen).Name <> "Daten" Then 
Sheets(Wiederholungen).Activate 
For Each Objekt In ActiveSheet.Shapes 
If Mid(Objekt.Name, 1, 7) = "Picture" Then 
Objekt.Delete 
End If 
Next 
End If 
Next 
Select Case Sheets("Daten").Range("C17") 
Rem: 1. Name 
Case "Name1" 
Sheets("Deckblatt").Activate 
Sheets("Deckblatt").Range("C23").Select 
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\  Beispielbild1a.jpg  ").Select 
With Selection 
.ShapeRange.LockAspectRatio = msoFalse 
.ShapeRange.Height = 85.5 
.ShapeRange.Width = 181.5 
End With 
Sheets("GV-Erträge").Activate 
Sheets("GV-Erträge").Range("M38").Select 
Sheets("GV-Erträge").Pictures.Insert(ActiveWorkbook.Path & "\  Beispielbild1b.jpg  ").Select 
With Selection 
.ShapeRange.LockAspectRatio = msoFalse 
.ShapeRange.Height = 127.5 
.ShapeRange.Width = 120.75 
.ShapeRange.Left = 500 
.ShapeRange.Top = 200 
End With 
Sheets("Daten").Activate 
Rem: 2. Name 
Case "Name2" 
Sheets("Deckblatt").Activate 
Sheets("Deckblatt").Range("C23").Select 
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\  Beispielbild2a.jpg  ").Select 
With Selection 
.ShapeRange.LockAspectRatio = msoFalse 
.ShapeRange.Height = 69# 
.ShapeRange.Width = 151.5 
End With 
Sheets("GV-Erträge").Activate 
Sheets("GV-Erträge").Range("M38").Select 
Sheets("GV-Erträge").Pictures.Insert(ActiveWorkbook.Path & "\  Beispielbild2b.jpg  ").Select 
With Selection 
.ShapeRange.LockAspectRatio = msoFalse 
.ShapeRange.Height = 116.25 
.ShapeRange.Width = 115.5 
.ShapeRange.Left = 500 
.ShapeRange.Top = 200 
End With 
Sheets("Daten").Activate 
End Select 
End If 
End Sub

Die Stellen, die es betrifft, habe ich Kursiv und Unterstrichen dargestellt.

Um ein Auswahlfeld mit den beiden Namen zu erhalten musst Du mit einem Gültigkeitsfeld arbeiten. Klicke die Zelle C17 an, gehe in der Menüleiste auf Extras => Gültigkeit…. Und wähle in der Registerkarte Einstellungen in dem Auswahlfeld den Eintrag Liste aus. Trage nun eine Zeile tiefer die Namen, die in dem Auswahlfeld angezeigt werden sollen, der Reihe nach immer mit einem Semikolon ( ; ) getrennt ein. Nach einem Klick auf OK stehen Dir die Namen in dem Auswahlfeld zur Verfügung.

Ich hoffe, Du kommst klar. Wenn nicht oder bei weiteren Fragen oder Problemen 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 6 von kvtv

Hallo Oliver,
vielen Dank für die Lösung. Hat alles super geklappt. Habe nur vergessen Dir zu sagen das die Tabellenblätter mit Passwort geschützt sind. Ohne Blattschutz funktioniert es ganz toll. Wenn die Blätter mit Passwort geschützt sind, bleibt das Makro beim "Objekt.Delete" hängen. Die Blätter sind mit dem Kennwort "Test" geschützt ! Kannst Du mir nochmal helfen?
Vielen Dank im voraus.
Gruß Karsten

Antwort 7 von coros

Hi Karsten,

dann sieht der Code wie folgt aus.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Objekt As Object, Wiederholungen As Integer
Application.ScreenUpdating = False
Rem:Blattschutz bei beiden Blättern aufheben
Sheets("Deckblatt").Unprotect "Test"
Sheets("GV-Erträge").Unprotect "Test"
If Target.Cells.Address = "$C$17" Then
For Wiederholungen = 1 To Worksheets.Count
If Sheets(Wiederholungen).Name <> "Daten" Then
Sheets(Wiederholungen).Activate
For Each Objekt In ActiveSheet.Shapes
If Mid(Objekt.Name, 1, 7) = "Picture" Then
Objekt.Delete
End If
Next
End If
Next
Select Case Sheets("Daten").Range("C17")
Rem: 1. Name
Case "Name1"
Sheets("Deckblatt").Activate
Sheets("Deckblatt").Range("C23").Select
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild1a.jpg").Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 85.5
.ShapeRange.Width = 181.5
End With
Sheets("GV-Erträge").Activate
Sheets("GV-Erträge").Range("M38").Select
Sheets("GV-Erträge").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild1b.jpg").Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 127.5
.ShapeRange.Width = 120.75
.ShapeRange.Left = 500
.ShapeRange.Top = 200
End With
Sheets("Daten").Activate
Rem: 2. Name
Case "Name2"
Sheets("Deckblatt").Activate
Sheets("Deckblatt").Range("C23").Select
Sheets("Deckblatt").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild2a.jpg").Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 69#
.ShapeRange.Width = 151.5
End With
Sheets("GV-Erträge").Activate
Sheets("GV-Erträge").Range("M38").Select
Sheets("GV-Erträge").Pictures.Insert(ActiveWorkbook.Path & "\Beispielbild2b.jpg").Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 116.25
.ShapeRange.Width = 115.5
.ShapeRange.Left = 500
.ShapeRange.Top = 200
End With
Sheets("Daten").Activate
End Select
End If
Rem:Blattschutz bei beiden Blättern einschalten
Sheets("Deckblatt").Protect "Test"
Sheets("GV-Erträge").Protect "Test"
End Sub


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 8 von kvtv

Hallo Oliver, Du bist ja schneller als die Polizei erlaubt. Kann aber erst nachher den Code testen. Danke erstmal. Melde mich nochmal wenn alles geklappt hat. Vielen Dank noch mal für Deine Bemühungen.
Gruß Karsten

Antwort 9 von kvtv

Hallo Oliver,
habe eben alles ausprobiert und es funktioniert alles bestens.
Danke nochmals für Deine promte und sehr, sehr, sehr schnelle Hilfe. Gruß Karsten

Antwort 10 von coros

Hi Karsten,

freut mich, wenn alles funktioniert. Danke Dir auch für die Rückmeldung.

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

Antwort 11 von kvtv

Hallo Oliver,
habe nun alles ausprobiert. Klappt auch alles wunderbar. Ich habe dann gemerkt das auf die gesperrten Zellen aber noch ein Zugriff in den geschützten Blättern möglich ist. Wie kann man in Deinem Makro beim Sperren, nur den Zugriff auf die freigegeben Zellen erlauben und nicht wie bei der Standardvorgabe von Excel, gesperrte und freigegeben Zellen.
Vielen Dank im voraus.
Gruß Karsten

Antwort 12 von coros

Hi Kartsen,

sorry, aber ich verstehe nur Bahnhof. Was meinst Du mit "Zugriff auf den geschützten Blättern" und mit dem Rest. Kannst Du das mal näher erklären, eventuell mit einem Beispiel?

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 13 von kvtv

Hi Oliver,
wenn man ein Blatt schützen will geht man doch über Blatt schützen. Da kann man nun ein Passwort eingeben und unten steht:
Alle Benutzer dieses Arbeitsblattes dürfen:
Dan kommt eine Auswahlliste mit verschiedenen Möglichkeiten. Unter anderem zuerst die beiden:
Gesperrte Zellen auswählen
Nicht gesperrte Zellen auswählen
die Standartmäßig angehakt sind.
Da liegt nun mein Problem. Die gesperrten Zellen sollen nicht ausgewählt werden, nur die nicht gesperrten Zellen. Mit deiner Lösung in Antwort 7 scheint beim Blatt schützen am Ende, dieser Haken für dem Zugriff auf gesperrte Zellen, nicht entfernt zu werden. Ich hoffe die Erklärung ist nun verständlicher. Sorry für die Umstände.
Vielen Dank für Deine Bemühungen.
Gruß Karsten

Antwort 14 von coros

Hi Karsten,

ich verstehe das immer noch nicht, was Du möchtest. Bei dem Makro werden in den Blättern "Deckblatt und "GV-Erträge" der Blattschutz aufgehoben. Dann werden die Bilder eingefügt und am Ende wird der Blattschutz in beiden Blättern wieder aktiviert. Was hat das nun mit nicht gesperrte Zellen und irgend welchen Haken die nicht entfernt werden zu tun?

Sorry, aber ich komme beim besten Willen nicht dahinter.

Wenn es Dir darum geht, dass nicht mehr alle Rechte vergeben werden wie vorher, wie z.B. "Benutzer darf gesperrte Zellen auswählen" und "Benutzer darf nicht gesperrte Zelle auswählen", dann kopiere in das Makro in die Zeilen, in denen die Unprotect-Anweisungen stehen die Zeile

, DrawingObjects:=True, Contents:=True, Scenarios:=True

dahinter. Damit werden die beiden Rechte wieder gestezt.

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 15 von kvtv

Hi Oliver,
ich weiß nicht wie ich Dir das erklären soll. Nachdem Dein Makro gelaufen ist kann ich nicht nur die gewollten und zum Ausfüllen benötigten Zellen Anklicken sondern (und das ist nicht gewollt) auch die gesperrten und ausgeblendeten (Formel) Zellen anklicken. Damit meine ich wenn ich unter Zellenformatierung den Schutz anklicke und dann bei gesperrt und bei ausgeblendet einen Haken hinmache. Damit möchte ich ja erreichen das im geschützten Blatt keiner die Zellen erreichen kann. Aber Deine

, DrawingObjects:=True, Contents:=True, Scenarios:=True
ist vieleicht schon die Lösung. Wenn ich nur wüßte welche Bezeichnung für die gesperrten Zellen ist dann könnte man hinter den ensprechendem Wert " =false" schreiben und alles dürfte erledigt sein. Oder??
Vielen Dank im voraus für Deine Bemühungen.
Gruß Karsten

Antwort 16 von coros

Hi Karsten,

jetzt habe ich es glaube ich verstanden. Tausche in dem Makro mal die Zeilen

Sheets("Deckblatt").Protect "Test"
Sheets("GV-Erträge").Protect "Test"


gegen die Zeilen

With Sheets("Deckblatt")
.Protect "Test"
.EnableSelection = xlNoSelection
End With
With Sheets("GV-Erträge")
.Protect "Test"
.EnableSelection = xlNoSelection
End With


aus. Damit müsste das gelingen, was Du möchtest.

Melde Dich, wenn es immer noch nicht das war, was Du wolltest.

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 17 von kvtv

Hallo Oliver,
habe alles ausprobiert. Nach der Änderung des Codes habe ich gar keinen Zugriff mehr auf alle Zellen gehabt.
Habe dann ein bißchen im Internet geschnüffelt und habe die Lösung meines Problems gefunden. Der Code muß nicht so heißen:

With Sheets("Deckblatt")
.Protect "Test"
.EnableSelection = xlNoSelection
End With
With Sheets("GV-Erträge")
.Protect "Test"
.EnableSelection = xlNoSelection
End With

sondern so:

With Sheets("Deckblatt")
.Protect "Test"
.EnableSelection = xlUnlockedCells
End With
With Sheets("GV-Erträge")
.Protect "Test"
.EnableSelection = xlUnlockedCells
End With

Nun funktioniert auch diese Geschichte. Vielen Dank. Ohne Deine Hilfe hätte ich das nie hin bekommen. Danke nochmal.
Gruß Karsten

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: