Saving a picture to a file using VBA

sverra

New Member
Joined
Nov 20, 2019
Messages
1
Saving a picture to a file



I have a small macro that loops round a large dataset and generates graphs, and saves them to “PNG” files. This works perfectly. See Sub graphs_to_files

What I need to do now is save multiple graphs copy and paste as a picture, then save that picture. The code under Sub save_picture works upto the last line.



HELP PLEASE



Sub graphs_to_file()

' Set up filename

Dim MyChartName As String
MyChartName = Range("D1") & ".png"

ActiveSheet.ChartObjects("Chart 6").Activate
ActiveChart.Export MyChartName
End Sub


Sub save_picture()

' Set up filename
Dim MyPictureName As String

MyPictureName = Range("D1") & ".png"
ActiveSheet.Shapes.Range(Array("Chart 1", "Chart 3", "Chart 2", "Chart 4", _
"Chart 5", "Chart 6", "Chart 7")).Select

Selection.Copy
Range("K56").Select
ActiveSheet.Pictures.Paste

ActiveSheet.Shapes.Range(Array("Picture 8")).Select
ActiveSheet.Shapes.Export MyChartName

End Sub
 

Some videos you may like

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,461
The procedure save_picture will first temporarily group the desired charts, then it passes the grouped charts and export filename to the procedure export_charts_shape, which creates a temporary chartobject for exporting the image.

VBA Code:
Option Explicit

Sub save_picture()

    ' Set up filename
    Dim MyPictureName As String
    MyPictureName = Range("D1") & ".png"
    
    ' Temporarily group the charts
    Dim MyChartsShape As Shape
    Set MyChartsShape = ActiveSheet.Shapes.Range(Array("Chart 1", "Chart 3", "Chart 2", "Chart 4", "Chart 5", "Chart 6", "Chart 7")).Group
    
    ' Call sub to export the grouped charts
    export_charts_shape MyChartsShape, MyPictureName
    
    ' Ungroup the charts
    MyChartsShape.Ungroup

End Sub

Sub export_charts_shape(ByVal ChartsShape As Shape, ByVal PictureName As String)

    ' create temporary chartobject for exporting ChartsShape
    With ActiveSheet.ChartObjects.Add(Left:=ChartsShape.Left, Top:=ChartsShape.Top, Width:=ChartsShape.Width, Height:=ChartsShape.Height)
        .Activate 'needed to prevent blank exported image files
        .Border.LineStyle = 0
        ChartsShape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        With .Chart
            .Paste
            .Export Filename:=PictureName, FilterName:="png"
        End With
        .Delete
    End With
    
End Sub

Hope this helps!
 

Watch MrExcel Video

Forum statistics

Threads
1,127,521
Messages
5,625,296
Members
416,089
Latest member
Captkraken33

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top