Copy a shape range and export as a PNG

[pupsia]

Hello all,

I have a Rectangle shape that has a fixed size and will not change even if the column or row size changes.
It works as a frame to put information in like: tables, shapes, pictures and so on.

ThisWorkbook.Sheets("Sheet4").Shapes.Range("Rectangle 1")

I`m trying to find a way to copy everything that is inside that "frame" and export as a picture.

Dim ExportPath As String
Dim objRange As Object

ExportPath = ThisWorkbook.Path & "\Case.png"

Set objRange = ThisWorkbook.Sheets("Sheet4").Shapes.Range("Rectangle 1")
objRange.Select

Selected.Export FileName:=ExportPath, Filtername:="PNG"

This code can copy the frame but nothing that is inside (for testing, I added a table).
When I manually press "past" it only adds the "frame"

Also the Export for some reason is not working.

Any idea how I could copy and export the whole range inside the shape?

 

[pupsia]

Right now, I`m using something like this to get the picture from a fixed range.
But I always have to adjust the range that is in the "frame".

Maybe there is a way to find out what range is inside the "frame" shape?

Sub Export4()


 Dim oWs As Worksheet
 Dim oRng As Range
 Dim oChrtO As ChartObject
 Dim lWidth As Long, lHeight As Long
 Dim ExportPath As String


ExportPath = ThisWorkbook.Path & "\Case.png"


 Set oWs = ActiveSheet
 Set oRng = oWs.Range("B2:G21")
 'Set oRng = ActiveSheet.UsedRange


 oRng.CopyPicture xlScreen, xlPicture
 lWidth = oRng.Width
 lHeight = oRng.Height


 Set oChrtO = oWs.ChartObjects.Add(Left:=0, Top:=0, Width:=lWidth, Height:=lHeight)


 oChrtO.Activate
 With oChrtO.Chart
  .Paste
  .Export FileName:=ExportPath, Filtername:="PNG"
 End With


 oChrtO.Delete


End Sub

 

[John_w]

Maybe there is a way to find out what range is inside the "frame" shape?

Compare the Width, Height, Left and Top properties of each shape inside the 'frame' with those of the 'frame' shape itself. Then Group the 'frame' shape and the shapes inside it so they can be handled as a single shape for exporting as a picture.

 

[pupsia]

John_w
Can it be done with a normal table in excel as well? In some cases I need to export tables with the size as well.
I'm using this 'frame' as a guideline. When I export my needed tables, designs and stuff using that 'frame', it comes in a perfect size that I need...

 

[John_w]

I don't think you can group a table and a shape together. Only multiple shapes can be grouped.

For a table, you can save the cells range it occupies, or the table object itself, as an image:

Public Sub Save_Range_As_Image()

    Dim imageFile As String
    
    imageFile = ThisWorkbook.Path & "\image.png"
    
    '----- Either -----
    
    Save_Object_As_Picture ActiveSheet.Range("C4:K19"), imageFile
    
    '----- Or -----
    
    Dim table1 As ListObject
    Set table1 = ActiveSheet.ListObjects("Table1")
    Save_Object_As_Picture table1.Range, imageFile

End Sub


Private Sub Save_Object_As_Picture(saveObject As Object, imageFileName As String)

    'Save a picture of an object as a JPG/JPEG/GIF/PNG file
    'Based on http://www.jpsoftwaretech.com/export-excel-range-to-a-picture-file/  (dead link)
    
    'Arguments
    'saveObject     - any object in the CopyPicture method's 'Applies To' list, for example a Range or Shape
    'imageFileName  - the .gif, .jpg, or .png file name (including folder path if required) the picture will be saved as
    
    Dim temporaryChart As ChartObject
     
    Application.ScreenUpdating = False
    
    saveObject.CopyPicture xlScreen, xlPicture
    
    Set temporaryChart = ActiveSheet.ChartObjects.Add(0, 0, saveObject.Width, saveObject.Height)
    With temporaryChart
        .Activate
        .Border.LineStyle = xlLineStyleNone      'No border
        .Chart.Paste
        .Chart.Export imageFileName
        .Delete
    End With
    
    Application.ScreenUpdating = True
    
    Set temporaryChart = Nothing
    
End Sub

Specifying a specific range (like the first method, above), would also work with the table and the shape(s), without grouping anything, as long as the range encompasses everything you want to save as an image.