Reputation: 86864
I'm trying to export all charts within my Excel file as a PNG image. The charts are not embedded in the worksheets, but have instead been moved as a new sheet upon creation.
Not being familiar with VBA or office macros, I've tried stringing together something based on code examples I found on the web but with no success.
Here's what I've tried, which may work with charts embedded within worksheets but not with standalone charts:
Private Sub ExportChartsButton_Click()
Dim outFldr As String
Dim ws As Worksheet
Dim co As ChartObject
outFldr = GetFolder(ActiveWorkbook.Path)
For Each ws In ActiveWorkbook.Worksheets
For Each co In ws.ChartObjects
co.Export outFldr & "\" & ws.Name & ".png", "PNG"
Next
Next
End Sub
When the button is clicked, nothing seems to happen.
If I replace the inner loop with MsgBox co.ChartObjects.Count
I get a 0
popup for each of my non-chart worksheets, so I'm obvious not iterating through the right objects (hence, no charts so nothing happens).
So, how do I iterate through Charts that are not embedded within worksheets?
Upvotes: 3
Views: 4887
Reputation: 113
Perhaps one of the easiest way to export by far is to save the whole workbook as a webpage. Excel will then automatically convert your charts to PNG's
Upvotes: 1
Reputation: 86864
I found a solution. I had to use ActiveWorkbook.Charts
instead of .Worksheets
.
Private Sub ExportChartsButton_Click()
Dim outFldr As String
Dim wc As Chart
Dim co As ChartObject
outFldr = GetFolder(ActiveWorkbook.Path)
If outFldr = "" Then
MsgBox "Export Cancelled"
Else
For Each wc In ActiveWorkbook.Charts
wc.Export outFldr & "\" & wc.Name & ".png", "PNG"
Next
End If
End Sub
And for the record, GetFolder()
is defined as:
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select folder to export Charts to"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show = True Then sItem = .SelectedItems(1)
End With
GetFolder = sItem
Set fldr = Nothing
End Function
Comments/suggestions very welcome.
Upvotes: 5