Last active
April 22, 2017 19:43
-
-
Save ateneva/029b41866d3b6ecbf1f2ac0488f9ecb9 to your computer and use it in GitHub Desktop.
Re-filter a pivot table and export the views to PowerPoint
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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