Pivoting Chart Items with VBA

A

Andy L

Andy
Local time
Today, 12:49
Joined
Mar 31, 2005
Messages
7
Hi Guys

Come to a complete halt with this one.

I am trying to fully automate copying and pasting pivot charts into a Powerpoint. This includes removing all the items from the pivotfield then adding items dependent on the date. It then copies the chart to Powerpoint.

After I run the code the pivotitems reset as required but the coding doesn't add the new pivot items.

USERDATE1, 2, 3 relate to 3 cells in the workbook which contain the last 3 months as seen in the pivotchart (Apr, May, Jun). The formula I use to get these is:
=TEXT(DATE(YEAR(TODAY()), MONTH(TODAY())-1, DAY(TODAY())),"MMM")
Obviously I change the -1 to get the different months.

The coding is as follows, I cannot include the whole file as the data is confidential:

Sub CommandButton29_Click()


Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim Slide1 As PowerPoint.Slide
Dim Slide2 As PowerPoint.Slide
Dim Slide3 As PowerPoint.Slide
Dim Slide4 As PowerPoint.Slide
Dim Slide5 As PowerPoint.Slide
Dim Slide6 As PowerPoint.Slide
Dim Slide7 As PowerPoint.Slide
Dim Slide8 As PowerPoint.Slide
Dim UserDate1 As String
Dim UserDate2 As String
Dim UserDate3 As String
Dim ch As Chart
Dim pf As PivotField
Dim pi As PivotItem
Dim strPF As String

UserDate1 = Worksheets("Pivot").Range("P1").Value
UserDate2 = Worksheets("Pivot").Range("Q1").Value
UserDate3 = Worksheets("Pivot").Range("R1").Value

Set PPApp = CreateObject("Powerpoint.Application")
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Add
Set Slide1 = PPPres.Slides.Add(1, ppLayoutBlank)
Set Slide2 = PPPres.Slides.Add(2, ppLayoutBlank)
Set Slide3 = PPPres.Slides.Add(3, ppLayoutBlank)
Set Slide4 = PPPres.Slides.Add(4, ppLayoutBlank)
Set Slide5 = PPPres.Slides.Add(5, ppLayoutBlank)
Set Slide6 = PPPres.Slides.Add(6, ppLayoutBlank)
Set Slide7 = PPPres.Slides.Add(7, ppLayoutBlank)
Set Slide8 = PPPres.Slides.Add(8, ppLayoutBlank)


Sheets("Cost By Area").Select

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide1.Select
Slide1.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If

Sheets("Warranty Summary").Select

ActiveSheet.ChartObjects("Chart 4").Activate
ActiveChart.ChartArea.Select

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlPrinter, _
Format:=xlPicture

' Paste chart
Slide2.Select
Slide2.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True


Sheets("Part Nos By Area").Select

ActiveChart.PivotLayout.PivotFields("Date Raised").CurrentPage = UserDate1

ActiveChart.PivotLayout.PivotFields("Europe").CurrentPage = "Europe"

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide3.Select
Slide3.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If

ActiveChart.PivotLayout.PivotFields("Europe").CurrentPage = "Asia"

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide5.Select
Slide5.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If

ActiveChart.PivotLayout.PivotFields("Europe").CurrentPage = "Americas"

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide7.Select
Slide7.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If

Sheets("Area Usage").Select

Set ch = ActiveChart
strPF = "Date Raised"

Set pf = ch.PivotLayout.PivotFields(strPF)
Application.DisplayAlerts = False
On Error Resume Next
With pf
.AutoSort xlManual, .SourceName
For Each pi In pf.PivotItems
pi.Visible = False
Next pi
.AutoSort xlAscending, .SourceName
End With
Application.DisplayAlerts = True

With ch.PivotLayout.PivotFields(strPF)
.PivotItems(UserDate1).Visible = True
.PivotItems(UserDate2).Visible = True
.PivotItems(UserDate3).Visible = True
End With


ActiveChart.PivotLayout.PivotFields("Support Area2").CurrentPage = "Europe"

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide4.Select
Slide4.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If


ActiveChart.PivotLayout.PivotFields("Support Area2").CurrentPage = "Asia"

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide6.Select
Slide6.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If

ActiveChart.PivotLayout.PivotFields("Support Area2").CurrentPage = "Americas"

If ActiveChart.HasPivotFields = True Then

ActiveChart.HasPivotFields = False

End If

' Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlPrinter, Size:=xlScreen, _
Format:=xlPicture

' Paste chart
Slide8.Select
Slide8.Shapes.Paste.Select

' Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

If ActiveChart.HasPivotFields = False Then

ActiveChart.HasPivotFields = True

End If


With PPPres
.SaveAs "C:\Documents and Settings\All Users\Desktop\RGM.ppt"
.Close
End With

PPApp.Quit

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub

Any help would be appreciated!
 
Howdy. Without seeing how this is working out in practice, not sure I can help.

I copy/paste/link XL charts and ranges all the time in PPT, with code. I have found that trying to do that with PivotCharts difficult. Perhaps you could go one step further and copy the Pivot as values, then you working without the PivotTable and without the PivotChart. It would give some flexibility.
________
Ford times specifications
 
Last edited:
BTW, Bill Jelen (Mr Excel) and Tracy Syrstad have a chapter about VBA and Pivot Tables in their book, VBA and Macros for MS Excel - excel-lent book!
________
GN125
 
Last edited:
Thanks for the book suggestion but I'm sure it's something simple that I'm missing!

Do you know if you can use strings to add pivot items to pivot charts?

Tried using this bit of code to pivot a table and I get the error Unable to set the visible property of the pivotitem class...

With ActiveSheet.PivotTables("PivotTable3").PivotFields("Date Raised")
.PivotItems("Apr").Visible = True
.PivotItems("May").Visible = True
.PivotItems("Jun").Visible = True
End With

I think this might be part of the problem but I don't understand what that is, as I recorded this bit?
 
Last edited:
Just cracked it!

Apparantly you cannot add pivot items if the chart is sorted automatically, as simple as that!!

Thanks for your help.
 
You must log in or register to reply here.

Similar threads

B
Set a pie chart with values from a listbox access vba
Replies
3
Views
293
b24 sofwtares
B
Rx_
Using MSAccess to remotely Pivot Filter and copy results to another tab (Automation)
Replies
0
Views
2,371
Rx_
Rx_
L
Excel graph in Access not updating
Replies
2
Views
1,514
JHB
J
T
problem with getfilter function for form/subform pivot
Replies
0
Views
793
tmcrouse
T
J
UnPivot columns with column data and column names in Access/VBA
Replies
6
Views
4,817
JHB
J

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom