Hi guys,
I'm having a problem with the creation of multiple PivotCharts in VBA, and I'm stuck since Friday evening
The goal is to build multiple PivotTables and associated PivotChart:
[VBA]
Sub CreatePivotCharts(SheetName As String)
'Creates multiple PivotTables and PivotCharts associated with the data
stored in
'sheet SheetName
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim SummarySheet As Worksheet
Dim I As Long, Row As Long
Dim NumTables As Long, Index As Long
Dim ItemName As String, IsEmbedded As Boolean
'All PivotTables are stored in a single sheet, called PivotTables
'Delete PivotTables sheet if exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("PivotTables").Delete
On Error GoTo 0
' Create PivotTables sheet
Set SummarySheet = Worksheets.Add
SummarySheet.name = "PivotTables"
SummarySheet.Move after:=Worksheets(Worksheets.count)
'Create Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=Sheets(SheetName).Range("A1").CurrentRegion.Address)
' Create Pivot Tables and PivotCharts
NumTables = NumProperties - 2 ' NumProperties is a global variable,
and the 'number of PivotTables to be written is equal to NumProperties
-2
Row = 3
For I = 1 To NumTables
Index = I + 2
Set PT = Sheets("PivotTables").PivotTables.Add( _
PivotCache:=PTCache, _
TableDestination:=SummarySheet.Cells(Row, 1))
'Add fields
With PT
'Rows
ItemName = Sheets(SheetName).Cells(1, 1)
.PivotFields(ItemName).Orientation = xlRowField
'Columns
ItemName = Sheets(SheetName).Cells(1, 2)
.PivotFields(ItemName).Orientation = xlColumnField
'Data
ItemName = Sheets(SheetName).Cells(1, Index)
With .PivotFields(ItemName)
.Orientation = xlDataField
' .Function = xlSum
End With
End With
' Create associated PivotChart
Call CreatePivotChart(ItemName, PT)
Row = Row + PT.TableRange1.Rows.count + 5 ' 5 rows of space
between each
' PivotTable
Next I
End Sub
[/VBA]
[VBA]
Sub CreatePivotChart(ChartName As String, PT As PivotTable)
' Create a PivotChart associated with PivotTable PT
Dim cht As Chart
'Delete PivotChart sheet if exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets(ChartName).Delete
On Error GoTo 0
' Add PivotChart sheet
Set cht = Charts.Add
cht.Move after:=Sheets(Sheets.count)
'MsgBox PT.TableRange1.Cells(1,1).Value
With cht
.name = ChartName
.SetSourceData Source:=PT.TableRange1 ' that's the line where the
code stops
'Change format
.ChartType = xlLineMarkers
End With
End Sub
[/VBA]
When I run the code, the first iteration of the For cycle in
CreatePivotCharts (the first subroutine) works fine, so the first
PivotTable and associated PivotChart are created all right. However,
at the second iteration, the code stops at the line indicated above
in subroutine CreatePivotChart (the second subroutine, yes I know I've
got a great fantasy for names
The following runtime error is given:
Run-time error '1004':
The source data of a PivotChart report cannot be changed. You can
change the view of data in a PivotChart report by reorganizing its
fields or items, or by changing its associated PivotTable report.
and, choosing the option "Debug", I can see that the PivotTable
presently selected in the sheet "PivotTables" is the first one, not
the second!! However, if I uncomment the line
MsgBox PT.TableRange1.Cells(1,1).Value
in the sub CreatePivotChart, I can see that at the second iteration PT
is pointing to the second PivotTable!! How's that possible? Can you
please help me? I cannot understand what's the problem, everything seems fine but I still get this error...Thanks in advance,
Best Regards
Sergio Rossi
Reply With Quote
