Forum home » Delegate support and help forum » Microsoft Excel VBA Training and help » Exporting Charts from Pivot tables using VBA
|
|
|
The UK's most regular Training information: |
|
Welcome. Please choose your application (eg. Excel) and then post your question. Our Microsoft Qualified trainers will then respond within 24 hours (working days). Frequently Asked Questions
Any suggestions, questions or comments? Please post in the Improve the forum thread. |
Exporting Charts from Pivot tables using VBA
Resolved · Urgent Priority · Version 2007
Reply Fri 24 Dec 2010, 14:27Delegate Adrian said...
Adrian has attended:
Excel Advanced course
Excel VBA Intro Intermediate course
Exporting Charts from Pivot tables using VBA
I have a workbook containing several worksheets. Within these spreadsheets are pivot charts which I export as jpeg's.
I have inherited an xla add-in file which is designed to export all the charts within the workbook. However two of the worksheets contain pivot tables which create several charts from the pivot. I have modified the add-inn to loop through all the worksheets within the workbook but need some code for the 2 sheets with the pivot tables so I can loop through each pivot item selected.
I've attached the code below as it looks at present.
Regards
Adrian Laffey
VBA Add-In (Export all charts)
Sub ExportAllCharts()
Dim sChartName As String
Dim sFileName As String
Dim sPathName As String
Dim sPrompt As String
Dim sCurDir As String
Dim iOverwrite As Long
Dim cCount As Integer
Dim loopChartName As String
Dim eFailed As Integer
Dim chartCount As Integer
Dim skipPrompt As Integer
Dim wksht As Worksheet
sCurDir = CurDir
If ActiveSheet Is Nothing Then GoTo ExitSub
' If ActiveChart Is Nothing Then GoTo ExitSub
If Len(Dir(ActiveWorkbook.Path & "\charts", vbDirectory)) = 0 Then
MkDir ActiveWorkbook.Path & "\charts"
End If
sPathName = ActiveWorkbook.Path & "\charts"
If Len(sPathName) > 0 Then
ChDrive sPathName
ChDir sPathName
End If
For Each wksht In ActiveWorkbook.Worksheets
ActiveWindow.Zoom = 300
chartCount = wksht.ChartObjects.Count
sFileName = "MyChart.png"
cCount = 0
skipPrompt = 0
Do
If eFailed <> 1 Then cCount = cCount + 1
eFailed = 0
loopChartName = "Chart " & cCount
If cCount > chartCount Then Exit Do
sChartName = wksht.Name & cCount
sChartName = Replace(sChartName, " ", "")
sChartName = sPathName & "\" & sChartName & ".png"
sFileName = FullNameToFileName(sChartName)
sPathName = FullNameToPath(sChartName)
If FileExists(sChartName) And skipPrompt = 0 Then
sPrompt = "A file named '" & sFileName & "' already exists in '" & sPathName & "'"
sPrompt = sPrompt & vbNewLine & vbNewLine & "Do you want to overwrite the existing file?"
iOverwrite = Assistant.DoAlert("Image File Exists", sPrompt, msoAlertButtonYesAllNoCancel, msoAlertIconQuery, msoAlertDefaultFirst, msoAlertCancelDefault, False)
'MsgBox(sPrompt, vbYesNoCancel + vbQuestion, "Image File Exists")
Select Case iOverwrite
Case vbYes
' do nothing, loop again
Case vbNo
eFailed = 1
Case vbCancel
GoTo ExitSub
Case 8
skipPrompt = 1
End Select
End If
wksht.ChartObjects(cCount).Activate
ActiveChart.Export sChartName, "PNG"
ActiveWindow.Zoom = 100
Loop
Next
ExitSub:
ActiveWindow.Zoom = 100
ChDrive sCurDir
ChDir sCurDir
End Sub
For upcoming training course dates see: Pricing & availability
RE: Exporting Charts from Pivot tables using VBA
Hi Adrian
Thanks for your post and additional detail. As we are on holidays at the moment I have allocated your post to one of my colleagues who is a VBA trainer to review when we reopen next week.
Kind regards
Jacob
Reply Mon 10 Jan 2011, 09:41Delegate Adrian said...
RE: Exporting Charts from Pivot tables using VBA
Hi Jacob,
I have not heard anything back from your colleague as yet.
Regards
Adrian
RE: Exporting Charts from Pivot tables using VBA
Hi Adrian
Thanks for your question
I have today received your question, and will be spending some time with it later today.
Regards
Stephen
Reply Tue 18 Jan 2011, 17:55Delegate Adrian said...
RE: Exporting Charts from Pivot tables using VBA
Hi Stephen,
It's been a week since you posted your message above and I have still not had any potential silution to my query.
Regards
Adrian
|