VBA Grafik einfügen ohne Select

[Semi069]

Hallo Zusammen,

wie kann man am besten beim untenstehenden Code das Select vermeiden:

Sheets("Hilfstabelle").Select
ActiveSheet.Shapes.Range(Array("Grafik 2")).Select
Selection.Copy
Sheets("RG").Select
Range("A4").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.1871002776, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.8417352882, msoFalse, msoScaleFromTopLeft


Grüße

Semi

[Klaus-Dieter]

Hallo,

versuche es mal so:

Code:

Sheets("Hilfstabelle").Shapes.Range(Array("Grafik 2")).Copy
   With Sheets("RG").Range("A4")
       .Paste
       .ShapeRange.ScaleWidth 1.1871002776, msoFalse, msoScaleFromTopLeft
       .ShapeRange.ScaleHeight 0.8417352882, msoFalse, msoScaleFromTopLeft
   End With

[schauan]

Hallöchen,

oder so:

Code:

Sub test()
Sheets("Hilfstabelle").Shapes("Grafik 2").Copy
   With Sheets("RG").Pictures.Paste
       .Top = Sheets("Hilfstabelle").Range("A4").Top
       .Left = Sheets("Hilfstabelle").Range("A4").Left
       .ShapeRange.ScaleWidth 1.1871002776, msoFalse, msoScaleFromTopLeft
       .ShapeRange.ScaleHeight 0.8417352882, msoFalse, msoScaleFromTopLeft
   End With
End Sub

[schauan]

Hallöchen,

zum Positionieren der Grafik ist bei .Top und .Left der Bezug auf die "Hilfstabelle" falsch, hier müsste auch "RG" rein.
So ein Fehler hätte auch vermieden werden können, wenn man die "Eltern" (.Parent) verwendet:

.Top = .Parent.Range("A4").Top
.Left = .Parent.Range("A4").Left

[snb]

Code:

Sub M_snb()
    Sheet1.Shapes(1).CopyPicture
    
    With Sheet2
       .Paste .Cells(4, 4)
       .Shapes(1).ScaleWidth 1.1871002776, 0
       .Shapes(1).ScaleHeight 0.8417352882, 0
    End With
End Sub