per VBA Bild laden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Hajo,
ich habe mich für diese Variante im Code entschieden, aber wie kann ich am besten diesen Makro "BildAnpassen" in deinem Code einfügen bzw. anpassen?
Sub BildAnpassen()
'aufgezeichnet von Zehra Agic 16.07.2010
With ActiveSheet.Shapes(2)
.LockAspectRatio = msoFalse
.Left = [D2].Left
.Top = [D2].Top
.Width = [D2:N2].Width
.Height = [D2].Height
End With
End Sub
Option Explicit ' Variablendefinition erforderlich

Private Sub Worksheet_Change(ByVal Target As Range)
Dim StOrdner As String                  ' Variable Ordner Bildablage
Dim StBild As String                    ' Variable Bildname
Dim InI As Integer                      ' Variable Schleifenzähler
Dim RaBereich As Range                  ' Variable Bereich der Gültigkeit
Dim RaZelle As Range                    ' Variable bearbeitete Zelle
Dim LoBreite As Long                    ' Variable Bildbreite
Dim LoHoehe As Long                     ' Variable Bildhöhe
' Ordner Bildablage
StOrdner = ThisWorkbook.Path & "\de-Bilder\"
Set RaBereich = Range("A3")       ' Bereich der Wirksamkeit
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then        ' falls nicht gefunden wird sub verlassen
For Each RaZelle In RaBereich           ' Schleife über alle veränderten Zellen
' Reaktion auf Zellveränderung abschalten
Application.EnableEvents = False
RaZelle.Offset(0, 1) = ""           ' Inhalt der Zelle neben Bildnamen löschen
' Reaktion auf Zellveränderung einschalten
Application.EnableEvents = True
' Bildname erstellen
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
If RaZelle.Value  "" Then         ' eine Eingabe ist vorhanden
' Bildname einschl. Ordner erstellen
StBild = StOrdner & Format(RaZelle.Value, "00000") & ".jpg"
If Dir(StBild) = "" Then        ' Prüfung ob Bild vorhanden
' Reaktion auf Zellveränderung abschalten
Application.EnableEvents = False
' Bild nicht vorhanden
Target.Offset(0, 1) = "kein Bild vorhanden!"
' Reaktion auf Zellverändeung einschalten
Application.EnableEvents = True
Else                            ' Bild vorhanden
' Bildgröße und Bild bei Position einfügen
Select Case Target.Address(False, False)
Case "A3"
LoBreite = 60
LoHoehe = 60
' 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
' erstes Offset Pos. Links 0 Zeilen und
' eine Spalte nach rechts
' zweites Offset Pos. Oben 0 Zeilen tiefer
' und 0 Spalten nach rechts
ActiveSheet.Shapes.AddPicture(StBild, True, True, _
RaZelle.Offset(0, 0).Left, _
RaZelle.Offset(5, 0).Top, LoBreite, _
LoHoehe).Name = "Bild " _
& RaZelle.Address(False, False)
End Select
End If
End If
Next RaZelle
End If
Set RaBereich = Nothing                 ' Variable leeren
End Sub

Lieben Gruß
Amina
(Frohe Weihnachten...)

…Amina!
AddPicture ist eine Methode der Shapes-Objektliste. Du solltest dich mal mit dem xlVBA-Objektmodell beschäftigen, wenn du VBA wirklich lernen willst. Da wäre für den Anfang die VBE(ditor)-Hilfe recht nützlich, denn da wdn auch die Parameter dieser Methode erklärt. Left:=RAZelle.Left ist ein solcher und bedeutet, dass der Abstand des Objektes vom linken TabRand dem Abstand von RAZelle von diesem entspricht. Bei dir soll das aber der Abstand von [D2] ⇒Range("D2") sein. Also müsstest du entweder RAZelle=Range("D2") setzen oder RAZelle durch [D2] ersetzen. Für Width und Height stehen bei Hajo extra Variablen, denen du zuvor die entsprechenden Werte (so wie du es hier mit RAZelle machen wolltest) zuweisen musst. Alternativ kannst du natürlich alles so schreiben wie du hier zeigst, aber jeweils alles vor und mit = weglassen. Gleiches gälte auch für .Address, aber das kommt mir hier durch den Anschluss mit & an Height, noch dazu in eigener Zeile (!), sehr sinnlos vor (Syntaxfehler!).
Hajo erwartet, dass man seine VBA-Vorschläge versteht und selbständig erforderliche Anpassungen vornehmen kann. Das ist auch insofern gerechtfertigt, indem niemand, der VBA anwenden will, erwarten kann, dass man ihm ein Komplett-Pgm für seinen speziellen Fall schreibt. Das kommt hier zwar häufig vor, sollte aber die Ausnahme sein. Denn unverstandene Pgmm einzusetzen ist ggf nicht nur gefährlich, sondern macht auch abhängig. Eine Dauerlösung kann das also nicht sein!
Ein guter Forumsbeitrag sollte also in 1.Linie Hilfe zur Selbsthilfe leisten, ggf auch den VBA-Einstieg für Anfänger erleichtern, mehr aber nicht unbedingt. Letztendlich muss ja auch der Frager für den Code geradestehen, nicht der Antworter. Bitte, bedenke das!
Fazit: Man kann/darf nur machen, was man auch kann/versteht. Wissen, wo's steht bzw stehen könnte, ist auch das Mindeste, was man wissen muss/sollte.
Gruß Luc :-?

Sub BildAnpassen() 'aufgezeichnet von Zehra Agic 16.07.2010 With ActiveSheet.Shapes(2) .LockAspectRatio = msoFalse .Left = [D2].Left .Top = [D2].Top .Width = [D2:N2].Width .Height = [D2].Height End With End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread