Einfügen mit Makro
14.07.2005 16:44:51
giovanni
habe unteres Makro bei Hajos HP gefunden.
Hier wird ein Bild automatisch aus Verzeichnis eingefügt.
Problem ist, dass das Bild immer auf der Höhe wo Eingabe erfolgt eingefügt wird.
Dort aber habe ich noch eine Menge Text stehen....
Wäre es möglich das Makro so zu verändern, dass das Bild immer 3 Zeilen tiefer eingebaut wird?
Der naheliegende Versuch einfach eine Verknüpfung zu einer anderen Zelle zu
machen, z.B. in A9 steht =A1 ist gescheitert, da in Zelle A9 mit Enter bestätigt werden muss....
Danke für jede Hilfe
gio
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' erstellt von Hajo.Ziplies@web.de 02.10.03
' <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a>
Dim StBild As String
Dim InI As Integer
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("A10,A20,A30,A40")
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
If Target.Value <> "" Then
' neues Bild einfügen
StBild = "C:\Temp\" & Format(RaZelle.Value, "00000") & ".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, 100, _
RaZelle.Top, 80, 80).Name = "Bild " & RaZelle.Address(False, False)
Else
' Standardbild einfüge falls Bild nicht vorhanden
StBild = "C:\Temp\keinBild.Jpg"
' einfügen ohne select von Bert Körn
' von Klausimausi64 Bildname
ActiveSheet.Shapes.AddPicture(StBild, True, True, 100, _
RaZelle.Top, 80, 80).Name = "Bild " & RaZelle.Address(False, False)
End If
End If
End If
Next RaZelle
Set RaBereich = Nothing
End Sub