CODEWITHSUNDEEP
vbaexcelcopy-paste
Yigit Tanverdi
Yigit Tanverdi

Reputation: 161

pasting a picture in a specified range with vba

I have this following code. I want to paste this copied Picture to a range which i select in Destinationsheet. However i only know how to set the Location by selecting .top , .left , .width , .height . Is there a way to paste this Picture in a selected range such as G30:J:30 ?

 Windows(osman).Activate

   Sheets("Overview").Range("A30:D37").CopyPicture


  Dim DestinationSheet As Worksheet
  Set DestinationSheet = Workbooks(anan).Sheets("Eingabefeld")

   DestinationSheet.Paste

  Dim pastedPic As Shape



   Set pastedPic = DestinationSheet.Shapes(1)

   With pastedPic
    .Top = DestinationSheet.Cells(17, 2).Top
    'Rest of positioning  code here

 End With

Upvotes: 1

Views: 12053

Answers (3)

Bo Knows
Bo Knows

Reputation: 1

once copying the chart, can do this way:

Sheets("Sheet1").Select
    Range("A1:H14").Select
    ActiveSheet.Paste
    ActiveChart.Parent.Width = Range("A1:H14").Width
    ActiveChart.Parent.Height = Range("A1:H14").Height

Upvotes: 0

Angelo E
Angelo E

Reputation: 11

this code is very close to what I want, I want to copy a range, as an image and insert it in a different sheet and size it to the outer boundries of a cell range. All is well, apart from one ghlitch, when the routine runs the "Set pastedPic = DestinationSheet.Shapes(1)" it picks up the last selected and the one before that object, ending in sizing the inserted picture and the shape before last... the way I manage to get some consistant results, was to change (1) to (2) the one before that, which apparently seens to be the copied entity... go figure...

Upvotes: 1

Sobigen
Sobigen

Reputation: 2169

I tested this and it worked for me. If you have a multicell range object you can get the width and height. If you don't change the .LockAspectRatio = msoFalse your picture may adjust itself. 

Dim r As Range
Set r = Me.Range("G30:J30")

With pastedPic
    .LockAspectRatio = msoFalse
    .Top = r.Top
    .Left = r.Left
    .Width = r.Width
    .Height = r.Height
End With

I tried you code this is what I came up with. For the copy picture line I actually copy a picture of the cells not a particular picture within those cells. Is that what you expected?

One other change was I used ThisWorkbook instead of your workbook index. Adjust as necessary

Sub test()
    Dim pastedPic As Shape
    Dim DestinationSheet As Worksheet
    Dim desitinationRange As Range
    Set DestinationSheet = ThisWorkbook.Sheets("Eingabefeld")

    Sheets("Overview").Range("A30:D37").CopyPicture
    DestinationSheet.Paste

    Set pastedPic = DestinationSheet.Shapes(1)
    Set desitinationRange = Me.Range("G30:J30")

    With pastedPic
         .LockAspectRatio = msoFalse
         .Top = desitinationRange.Top
         .Left = desitinationRange.Left
         .Width = desitinationRange.Width
         .Height = desitinationRange.Height
     End With
End Sub

Upvotes: 0

Related Questions