Skip to content

Instantly share code, notes, and snippets.

@ateneva
Last active April 22, 2017 19:43
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ateneva/029b41866d3b6ecbf1f2ac0488f9ecb9 to your computer and use it in GitHub Desktop.
Save ateneva/029b41866d3b6ecbf1f2ac0488f9ecb9 to your computer and use it in GitHub Desktop.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment