Export interactive chart embedded on a worksheet to PowerPoint

ForEachChtObjInWbk_ExportToPPT.bas

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 Cell As Range
Dim Country As Range

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 HC charts from Dashboard tab (This is .ChartObjects collection and Object must always be activated first)
Worksheets("Dashboard").Activate
Set Country = ActiveSheet.Range("C8")

    For Each Cell In ActiveSheet.Range("U17:AD17")
        Country = Cell.Value
        
        Set ChtObj = ActiveSheet.ChartObjects("HC")
        ChtObj.Activate
        ActiveChart.ChartArea.Copy

        Select Case Country
            Case "C": PPpres.Slides(4).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "F": PPpres.Slides(5).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "G": PPpres.Slides(6).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "GW": PPpres.Slides(7).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "IB": PPpres.Slides(8).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "IT": PPpres.Slides(9).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "M": PPpres.Slides(10).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "R": PPpres.Slides(11).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "U": PPpres.Slides(12).Shapes.PasteSpecial ppPasteEnhancedMetafile
            Case "H": PPpres.Slides(13).Shapes.PasteSpecial ppPasteEnhancedMetafile
        End Select
    Next Cell

PPpres.Save
End Sub