ateneva
4/22/2017 - 7:43 PM

Re-filter a pivot table and export the views to PowerPoint

Re-filter a pivot table and export the views to PowerPoint

Sub Utilization()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'written by Angelina Teneva, 2013
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Application.Calculation = xlCalculationAutomatic

Dim PT As PivotTable
Dim PF As PivotField
Dim PI As PivotItem
Dim L As String
Dim PL As String

Dim Sh As Shape
Dim PPApp As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

'Create a PP application and make it visible
Set PPApp = New PowerPoint.Application
PPApp.Visible = msoCTrue

'Open the presentation you wish to copy to
Set PPpres = PPApp.Presentations.Open("C:\Users\Angelina\Desktop\Utilization.pptm")

'************************************************************
'prevent PowerPoint 2013 from losing focus and returning
'"shapes (unknown member) invalid request. the specified data type is unavailable"
'- Run-time error -2147188160 (80048240):View (unknown member) error
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
PPApp.Activate
PPApp.ActiveWindow.ViewType = ppViewNormal
PPApp.ActiveWindow.Panes(2).Activate 'standard ppt view
'**********************************************************************************************************************
'get Delivery Pillar Utilization
'**********************************************************************************************************************
Worksheets("Utilization").Activate
Set PT = Worksheets("Utilization").PivotTables("PivotTable1")

PT.PivotFields("Pillar").ClearAllFilters
PT.PivotFields("Pillar").PivotFilters.Add Type:=xlCaptionEquals, Value1:="Delivery"
       
For Each PT In ActiveSheet.PivotTables
    Set PF = PT.PivotFields("Subregion ")
        PF.ClearAllFilters
        
        For Each PI In PF.PivotItems
            L = PI.Value
            PF.CurrentPage = L
            
            PT.PivotSelect "", xlDataAndLabel, True
            Selection.Copy
            
            Select Case L
                Case "CEE": PPpres.Slides(2).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "FRA": PPpres.Slides(11).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "GER": PPpres.Slides(20).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "GWE": PPpres.Slides(29).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "IBE": PPpres.Slides(38).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "ITA": PPpres.Slides(47).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "MEMA": PPpres.Slides(56).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "UKI": PPpres.Slides(65).Shapes.PasteSpecial ppPasteEnhancedMetafile
                Case "RUS": PPpres.Slides(73).Shapes.PasteSpecial ppPasteEnhancedMetafile

            End Select
        Next PI
Next PT

PPpres.Save
PPpres.Close

End Sub