ateneva
4/23/2017 - 11:22 AM

Export all the chartsheets from the currently active workbook to PowerPoint

Export all the chartsheets from the currently active workbook to PowerPoint

Sub ExportFSCSlides()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'written by Angelina Teneva, 2015
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Dim PPApp As PowerPoint.Application
Dim PPpres As PowerPoint.Presentation

Dim pptx As String
pptx = ActiveWorkbook.Worksheets("calculated fields").Range("F2")

Dim Cht As Chart
Dim ChtObj As ChartObject
Dim i As Integer

'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(pptx)

'************************************************************
'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
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'copy the chartsheets
For Each Cht In ActiveWorkbook.Charts  
    i = Cht.Index
    Cht.ChartArea.Copy

    Select Case i
        Case 5: PPpres.Slides(2).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case 6: PPpres.Slides(3).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case 7: PPpres.Slides(15).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case 8: PPpres.Slides(15).Shapes.PasteSpecial ppPasteEnhancedMetafile
    End Select
    
Next Cht

PPpres.Save
End Sub