How Do I Quickly Export Multiple PivotTables to PowerPoint Slides?

I’ve got to convert all those pivot tables into slides and it’s taking ages!

No worries! It’s not all doom and gloom!  I did write about a similar technique recently.

This one is a little bit trickier because you’ve got to deal with multiple pivot tables per workbook rather than just one based in a particular sheet, but the code is still very similar in nature – it just needs a couple of extra loops and a mechanism to precisely determine where each table needs to go.

Giving specific names to your pivot tables will help you with this!

And below is a fully-fledged example of a code that exports multiple pivot tables by opening a pre-defined closed presentation

Sub ExcelToPowerPoint_Open()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Angelina Teneva, Aug 2014
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim Sh As Shape
Dim PPApp As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPS As Integer
Dim Wks As Worksheet
Dim PT As PivotTable
Dim PF As PivotField
Dim PF2 As PivotField
Dim PL As String
'Create a PP application and make it visible
Set PPApp = New PowerPoint.Application
PPApp.Visible = True
'Open the presentation you wish to copy to
Set PPpres = PPApp.Presentations.Open("C:\Users\Angelina\Documents\Import-Export Balance.pptm")
'prevent PowerPoint 2013 from losing focus and returning
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
PPApp.Activate
PPApp.ActiveWindow.ViewType = ppViewNormal
PPApp.ActiveWindow.Panes(2).Activate
'************************************************************************************************
If ActiveWorkbook.Worksheets.Count = 9 Then Application.Run "PERSONAL.XLSB!Export_PPT_Internal"
If ActiveWorkbook.Worksheets.Count = 8 Then 'check if it is import file
Worksheets("Project Import (RD&CoE)").Activate
With ActiveSheet
Range("A1:N4").Copy
'copy the header of the worksheet on the PowerPoint slide
For PPS = 2 To 12 Step 2
PPpres.Slides(PPS).Shapes.PasteSpecial ppPasteEnhancedMetafile
Next PPS
'copy each pivot table content
For Each PT In ActiveSheet.PivotTables
PL = PT.name
PT.PivotSelect "", xlDataAndLabel, True
Selection.Copy
'determine the slide where the pivot table picture should be pasted based on the PT name
Select Case PL
Case "TC": PPpres.Slides(2).Shapes.PasteSpecial ppPasteMetafilePicture
Case "SIS": PPpres.Slides(12).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "CFS": PPpres.Slides(8).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "IC": PPpres.Slides(6).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "DCC": PPpres.Slides(4).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "NMC": PPpres.Slides(10).Shapes.PasteSpecial ppPasteEnhancedMetafile
End Select
Next PT
End With
End If
'*********************************************************************************************
If ActiveWorkbook.Worksheets.Count >= 10 Then
Worksheets("Export Pivot % breakdown").Activate 'check if it is Export file
With ActiveSheet
Range("A1:L4").Copy
'copy the header of the worksheet on the PowerPoint slide
For PPS = 1 To 11 Step 2
PPpres.Slides(PPS).Shapes.PasteSpecial ppPasteEnhancedMetafile
Next PPS
'copy each pivot table content
For Each PT In ActiveSheet.PivotTables
PL = PT.name
PT.PivotSelect "", xlDataAndLabel, True
Selection.Copy
'determine the slide where the pivot table picture should be pasted based on the PT name
Select Case PL
Case "TC": PPpres.Slides(1).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "SIS": PPpres.Slides(11).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "CFS": PPpres.Slides(7).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "IC": PPpres.Slides(5).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "DCP": PPpres.Slides(3).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "NMC": PPpres.Slides(9).Shapes.PasteSpecial ppPasteEnhancedMetafile
End Select
Next PT
End With
End If
Application.CutCopyMode = False
PPpres.Save
PPpres.Close
End Sub

What if I want to export the pivot table content to a presentation that’s already open?

You need a minor tweak in the code that’s calling your PowerPoint application!

'open existing PowerPoint Application (Excel VBA)
'————————————————————————————————-
Dim PPApp As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Set PPApp = New PowerPoint.Application 'creates a PP application and makes it visible
PPApp.Visible = True
'Open the presentation you wish to copy to
Set PPpres = PPApp.Presentations.Open("C:\Users\Angelina\Documents\Import-Export Balance.pptm")
'—————————————————————————————————-
'call PowerPoint application that's already open (Excel VBA)
Dim PPApp As PowerPoint.Application
Set PPApp = GetObject(, "Powerpoint.Application") 'use if you are planning on having your ppt open
Dim PPpres As PowerPoint.Presentation
Set PPpres = PPApp.ActivePresentation

Here’s a full example of a VBA code that exports to open presentation

Sub Export_PPT_Internal()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Angelina Teneva, Aug 2014
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim Sh As Shape
Dim PT As PivotTable
Dim PL As String
Dim PPApp As PowerPoint.Application
Set PPApp = GetObject(, "Powerpoint.Application") 'use if you are planning on having your ppt open
Dim PPpres As PowerPoint.Presentation
Set PPpres = PPApp.ActivePresentation
Dim PPS As Integer
Dim Wks As Worksheet
'prevent PowerPoint 2013 from losing focus
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
PPApp.Activate
PPApp.ActiveWindow.ViewType = ppViewNormal
PPApp.ActiveWindow.Panes(2).Activate
'*******************************************************************************************
Worksheets("Int Imp % cat").Activate 'export internal imports
With ActiveSheet
'put date stamp
Range("A1:O3").Copy 'date stamp on Slides
For PPS = 14 To 19
PPpres.Slides(PPS).Shapes.PasteSpecial ppPasteEnhancedMetafile
Next PPS
For Each PT In ActiveSheet.PivotTables
PL = PT.name
PT.PivotSelect "", xlDataAndLabel, True
Selection.Copy
Select Case PL
Case "DCC": PPpres.Slides(15).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "IC": PPpres.Slides(16).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "CFS": PPpres.Slides(17).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "TC": PPpres.Slides(14).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "SIS": PPpres.Slides(18).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "NMC": PPpres.Slides(19).Shapes.PasteSpecial ppPasteEnhancedMetafile
End Select
Next PT
End With
PPpres.Save
'****************************************************************************************************
'export internal exports
If ActiveWorkbook.Worksheets("Internal Export %").Visible = False Then Worksheets("Internal Export -new-").Visible = True
ActiveWorkbook.Worksheets("Internal Export %").Activate
With ActiveSheet
Range("A1:N3").Copy 'put a date stamp
For PPS = 23 To 28
PPpres.Slides(PPS).Shapes.PasteSpecial ppPasteEnhancedMetafile
Next PPS
For Each PT In ActiveSheet.PivotTables
PL = PT.name
PT.PivotSelect "", xlDataAndLabel, True
Selection.Copy
Select Case PL
Case "DCC": PPpres.Slides(24).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "IC": PPpres.Slides(25).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "CFS": PPpres.Slides(26).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "TC": PPpres.Slides(23).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "SIS": PPpres.Slides(27).Shapes.PasteSpecial ppPasteEnhancedMetafile
Case "NMC": PPpres.Slides(28).Shapes.PasteSpecial ppPasteEnhancedMetafile
End Select
Next PT
End With
PPpres.Save
End Sub

Don’t forget that if any of these is to run, you need to have the Microsoft PowerPoint Object Library enabled in your Excel VBE environment!

Happy VBA coding!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.