Office: (Office 2007) Mehrere Bilder per VBA einfügen?

Hallo an alle!

Bei meiner Artikeliste gibt es eine Tabelle "Datenblatt", bei der ich eine Artikelnr. eingebe und über SVERWEIS werden dann die einzelen Daten dazu aufgelistet. Es sollen auch Bilder, die im gleichen Ordner sind zu dem jeweiligen Artikel angezeigt werde, wozu ich ein Makro von Hajo Ziplies benutzte, was aber noch nicht so funktioniert.

1. Die Namen der Bilder wird über ein SVERWEIS ermittelt, d.h. die eingentlichen Zellen, in denen der Name steht werden nicht durch ein CHANGE ereignis erkannt, was das Makro von Hajo aber benötigt. Man kann zwar die einzelnen Felder mit F2 und Enter aktivieren wodurch die Bilder angezeit werden, ist jedoch umständlich. Gibt es nicht eine Möglichkeit, dass das Makro nach eingabe der Artikelnr. die einzelne Bilder schon einfügt.

2. Die Bilder sind in meiner Liste waagerecht angeordnet. Wenn das Marko ausgeführt wurde sind alle Bilder auf der geleichen Stelle eingefügt, anstatt neben der Zelle mit dem Bildnamen. Mit dem Makrorecorder hatte ich das verschieben der Bilder auf die richtige Stelle aufgezeichnet, kann dieses Makro aber nicht mit dem von Hajo verbinden (da VBA bei mir noch *confused.gif* ) , sonder muß es zusätzlich aufrufen.

3. Ist es noch möglich, das wenn man ein Bild anklickt, dieses im Vordergrund vergößert wird und bei einem nochmaligen anklicken wieder verkleinert?

Für Hilfe bedanke ich mich jetzt schon.

:)

 

Hallo,
wollte eigentlich meine Tabelle angehangen haben.
Gruß CBA

 

Moin, CBA,

Hajo nutzt in seinem Vorgehen ein Klassenereignis, was die Eingabe in die Zelle A9 als Auslöser benötigt. Allgemeine Makros können nach Bedarf aufgerufen werden - mir scheint, Du solltest ein solches nutzen und kein Klassenmodul (bzw. das Klassenmodul umschreiben, damit bei einer Änderung alle Vorgänge ausgelöst werden, was bei Formeln und Funktionen wegen der Neuberechnung eigentlich nicht zu befürworten ist). Für Formeln reicht es nicht aus, wenn man die Zellen als Bereiche für die Eingabe angibt, die nur neu berechnet werden...

Wenn Du das Makro genau übernommen hast, sind die Daten zum Einfügen für alle Bilder/Grafiken identisch. Dein Makro zum Verschieben kann vor End Sub bei Hajo entweder mit Call DeinMakroName oder einfach nur durch DeinMakroName aufgerufen werden.

Zur dritten Frage solltest Du Dir vielleicht einmal Bild in Excel vergrößern/verkleinern ansehen...

 

Hallo jinx,
danke für deine schnelle Antwort, aber wie kann ich auch Hajo's Makro ein Klassenmodul machen? Bei meinen Versuch das Makro einfach in ein Klassenmodul zu kopieren klappt nicht.

Mein Versuch
Private Sub Worksheet_Change(ByVal Target As Range)

' Bereich zum Auslösen wird auf unten angegeben Zellen eingeschränkt
If Intersect(Target, Range("C2")) Is Nothing Then Exit Sub
Call bild_einfuegen_hajo(Target)

End Sub


In ein Klassenmodul wollte ich einfach dies reinkopieren

Sub bild_einfuegen_hajo(RaBereich As Range)
' erstellt von Hajo.Ziplies@web.de 02.10.03
' http://home.media-n.de/ziplies/
Dim StBild As String
Dim InI As Integer
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A14,D14,G14,J14,A17,D17,G17,J17")
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
' Bildname feststellen
StBild = "Bild " & RaZelle.Address(False, False)
' altes Bild löschen von Jinx
For InI = ActiveSheet.Shapes.Count To 1 Step -1
If ActiveSheet.Shapes(InI).Name = StBild Then
ActiveSheet.Shapes(InI).Delete
Exit For
End If
Next

' neues Bild einfügen
StBild = ActiveWorkbook.Path & "\" & Format(RaZelle.Value, "") & ".jpg"
If Dir(StBild) "" Then
' einfügen ohne select von Bert Körn
' Ausdruck.AddPicture(FileName, Verknüpfung, in Mappe speichern,
' Pos. Links, Pos. Oben, Breite, Höhe)
' von Klausimausi64 Bildname
ActiveSheet.Shapes.AddPicture(StBild, True, True, 21, _
RaZelle.Top, 140, 104).Name = "Bild " & RaZelle.Address(False, False)
' ********
Else
' Standardbild einfüge falls Bild nicht vorhanden
StBild = ActiveWorkbook.Path & "\blanko.jpg"
' einfügen ohne select von Bert Körn
' von Klausimausi64 Bildname
ActiveSheet.Shapes.AddPicture(StBild, True, True, 20, _
RaZelle.Top, 140, 104).Name = "Bild " & RaZelle.Address(False, False)
End If
End If
Next RaZelle
Set RaBereich = Nothing
End Sub

Da das obige Bsp. nicht funktioniert, habe ich einen CommandButton meinem Datenblatt zugefügt und mit Makro2 verbunden, kann man dieses Makro nicht mit dem von Hajo verbinden?

Sub Makro2()
'
' Bilder einlesen
Range("A14").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_1"""
Range("D14").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_2"""
Range("G14").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_3"""
Range("J14").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_4"""
Range("A17").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_5"""
Range("D17").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_6"""
Range("G17").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_7"""
Range("J17").Select
ActiveCell.FormulaR1C1 = "=R2C3 & ""_8"""
Range("J18").Select

'bilder verschieben
ActiveSheet.Shapes("Bild J14").Select
Selection.ShapeRange.IncrementLeft 486
Selection.ShapeRange.IncrementTop 0.75

ActiveSheet.Shapes("Bild G14").Select
Selection.ShapeRange.IncrementLeft 324
Selection.ShapeRange.IncrementTop 0.75

ActiveSheet.Shapes("Bild D14").Select
Selection.ShapeRange.IncrementLeft 161.75
Selection.ShapeRange.IncrementTop 0.75

ActiveSheet.Shapes("Bild J17").Select
Selection.ShapeRange.IncrementLeft 486
Selection.ShapeRange.IncrementTop 0.75

ActiveSheet.Shapes("Bild G17").Select
Selection.ShapeRange.IncrementLeft 324
Selection.ShapeRange.IncrementTop 0.75

ActiveSheet.Shapes("Bild D17").Select
Selection.ShapeRange.IncrementLeft 161.75
Selection.ShapeRange.IncrementTop 0.75

ActiveSheet.Range("C2").Select


End Sub
______________________________________

Den Link zum Bild vergößern und verkleinern kannte ich schon. Ist es aber möglich, dass das Makro nicht auf einem festen Bildernamen beschränkt ist, sonder auf das Bild angewendet wird, welches gerade angeklickt wird.

Sub Bild1_BeiKlick()
ActiveSheet.Shapes("Bild A14").Select
Selection.ShapeRange.ZOrder msoBringToFront
With Selection.ShapeRange
If .Height < 150 Then ' ggf. anpassen
.ScaleWidth 1, msoTrue, msoScaleFromTopLeft
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
Range("A14").Select
ElseIf .Height > 150 Then ' ggf. anpassen
.ScaleWidth 0.35, msoTrue, msoScaleFromTopLeft
.ScaleHeight 0.35, msoTrue, msoScaleFromTopLeft
Range("C2").Select
End If
End With
End Sub

 

Moin, CBA,

irgendwie sieht der Code jetzt ganz anders aus... *wink.gif*

Code:

 

Hallo CBA,

da war jinx schneller,

ich habe mich mal um den Part einfügen der Bilder den Du auf der Grundlage meines Makros gemacht hast gekümmert.

Code:

Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Home SP2 und Excel Version 2003 SP1.

 

Hallo jinx und Hajo,

erstmals Danke für euere tolle Leistung hier im Forum.

Ich habe das Makro von von Hajo genommen, das super funktioniert.

Habt Ihr oder jemand anders vielleicht noch eine Lösung, um die Bilder mit einem Mausklick zu vergößern oder zu verkleinern s.o. "Bild1_BeiKlick", oder muß ich für jedes Bild ein eigenes Makro anlegen?

MfG
CBA

 

Moin, CBA,

anlegen nicht, aber zuweisen schon - das würde ich beim Anlegen gleich miteinfügen:

Code:

 

Hallo jinx,
dein Makro "Bild_beiKlick" klappt auch Klasse.

vor der "With" Anweisung habe ich noch "Selection.ShapeRange.ZOrder msoBringToFront" eingetragen, damit das Bild in den Vordergrund geholt wird.

Durch deine Bemerkung über die Maße habe ich Bilder mit anderen Maßen probiert, die dann nicht mehr richtig verkleinert werden, da diese im Original andere Maßen haben als meine Bsp-Bilder.

Wie sieht die Auswertung durch eine Select Case-Anweisung bei unterschiedlichen Maßen des Bildes aus?

und kann man das Bild bei der Vergößerung an der Zelle A14 ausrichten und bei der Verkleinerung wieder an die ursprüngliche Lage mit der vorherigen Maße zurückbringen?

Gruß
CBA

 

Hallo CBA,

da ich das erste Beispiel schon auf meine HP hochgeladen habe wäre dieser Kick noch eine Klasse Ergänzung. Ich habe jetzt mal ein wenig getestet und eine Variante mit Veränderung des Namens gewunden. Um die Position habe ich mich jetzt nicht gekümmert.

Code:

Gruß Hajo

Das Forum lebt auch von den Rückmeldungen.