Bild kopieren

Sub GraphicGenauInEinenSelectiertenBereichEinfuegen()
Dim wksZiel As Worksheet
Dim shpNeu As Shape
Dim rngZiel As Range
Dim dblTop As Double
Dim dblLeft As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim strPfadUndDateiNameGraphicFile As String
strPfadUndDateiNameGraphicFile = Application.GetOpenFilename()
Set wksZiel = ActiveSheet
Set rngZiel = Selection 'Einfügen in Bereich Beispiel
dblTop = rngZiel.Top
dblLeft = rngZiel.Left
dblHeight = wksZiel.Cells(rngZiel.Row + rngZiel.Rows.Count, rngZiel.Column).Top - dblTop
dblWidth = wksZiel.Cells(rngZiel.Row, rngZiel.Column + rngZiel.Columns.Count).Left - dblLeft
Set shpNeu = wksZiel.Shapes.AddPicture _
(Filename:=strPfadUndDateiNameGraphicFile, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=dblLeft, _
Top:=dblTop, _
Width:=dblWidth, _
Height:=dblHeight)
shpNeu.Placement = xlMoveAndSize
'shpNeu.Name = "MeinBild" 'ggf Name vergeben oder weglassen
shpNeu.Select 'nur wenn es selectiert wird wird das Shape sofort sichtbar ansonsten Zeile  _
weglassen
End Sub

Workbook.Sheets(1).Cells(ActiveCell.Row, 29).Copy Destination:=ThisWorkbook.Sheets(2).Cells(67, 2)

Objekt erforderlich