CODEWITHSUNDEEP
excelvba
John Guy
John Guy

Reputation: 11

Save all shapes in a grouped picture as a png file

I need to select a grouped shape in Excel and save it with the name XX.PNG in a specific file location.

I tried the code below.

Public Sub AddChartObjects()
    
    Dim chtObj As ChartObject
    Dim ment As Variant
    With ThisWorkbook.Worksheets("SUMMARY INFOGRAPHIC")
        .Activate
            
        Set chtObj = .ChartObjects.Add(100, 30, 400, 250)
        chtObj.Name = "TemporaryPictureChart"
    
        'resize chart to picture size
        chtObj.Width = .Shapes().Group("group 17").Width
        chtObj.Height = .Shapes().Group("group 17").Height
    
        ActiveSheet.Shapes.Range(Array("TestPicture")).Select
        Selection.Copy
    
        ActiveSheet.ChartObjects("TemporaryPictureChart").Activate
        ActiveChart.Paste
    
        ActiveChart.Export Filename:="I:\Blenheim House\Analytics\North Region Report Library\Friends & Family\downloads\June\final versions\filename.jpg", FilterName:="jpg"
    
        chtObj.Delete
    End With
End Sub

Upvotes: 1

Views: 955

Answers (1)

Domenic
Domenic

Reputation: 8114

Assuming that you've named your group of shapes "group 17", you can simply refer to them using the Shapes object...

    'resize chart to picture size
    chtObj.Width = .Shapes("group 17").Width
    chtObj.Height = .Shapes("group 17").Height

Also, your code can be re-written as follows...

Public Sub AddChartObjects()

    Dim chtObj As ChartObject

        With ThisWorkbook.Worksheets("SUMMARY INFOGRAPHIC")
            .Activate

            Set chtObj = .ChartObjects.Add(100, 30, 400, 250)
            chtObj.Name = "TemporaryPictureChart"

            'resize chart to picture size
            chtObj.Width = .Shapes("group 17").Width
            chtObj.Height = .Shapes("group 17").Height

            .Shapes("group 17").Copy

            With chtObj
                .Activate
                With .Chart
                    .Paste
                    .Export Filename:="I:\Blenheim House\Analytics\North Region Report Library\Friends & Family\downloads\June\final versions\filename.jpg", FilterName:="jpg"
                End With
                .Delete
            End With
        End With

End Sub

Hope this helps!

Upvotes: 1

Related Questions