HERBERS Excel-Forum - das Archiv

Thema: Mit Schleife mehrere Grafiken einfügen | Herbers Excel-Forum

Mit Schleife mehrere Grafiken einfügen
Joachim

Hi,
ich habe auf einem Sheet ("BILDER") 4 Grafiken.
auf meinem Datensheet ("Daten") möchte ich in der Spalte T eine schleife starten, die folgendes mache soll:
Wenn in der Spalte E "Baum" steht, soll aus dem Tabellenblatt "Bilder" die Grafik "Picture7" kopiert und im Sheet "Daten" in der gleichen Zeile in der Spalte T eingefügt werden.
Wenn in der Spalte E "Auto" steht, soll aus dem Tabellenblatt "Bilder" die Grafik "Picture9" kopiert und im Sheet "Daten" in der gleichen Zeile in der Spalte T eingefügt werden.
So soll Zeile für Zeile durchgearbeitet werden.
Wie mache ich das mit einem Makro
Dank Euch
Gruss
Joachim

AW: Mit Schleife mehrere Grafiken einfügen
fcs

Hallo Joachim,
das nachfolgende Makro erledigt diesne Kopiervorgang.
Gruß
Franz
Sub BilderCopy()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Dim objShape As Shape, Zeile As Long
Set wksZiel = Worksheets("DATEN")
Set wksQuelle = Worksheets("BILDER")
With wksZiel
'Zeilen mit daten in Spalte E abarbeiten
For Zeile = 1 To .Cells(.Rows.Count, 5).End(xlUp).Row
'Bild gemäß Wert in Zelle in Spalte E (5) festlegen
Select Case .Cells(Zeile, 5).Value
Case "Baum"
Set objShape = wksQuelle.Shapes("Picture7")
Case "Auto"
Set objShape = wksQuelle.Shapes("Picture9")
Case Else
'do nothing
Set objShape = Nothing
End Select
If Not objShape Is Nothing Then
'Bild kopieren
objShape.Copy
.Paste
'Bild positionieren in Spalte T (20)
Set objShape = .Shapes(.Shapes.Count)
With .Cells(Zeile, 20)
objShape.Top = .Top
objShape.Left = .Left
End With
End If
Next
End With
End Sub