Exporting Charts from Pivot tables using VBA | Excel forum

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