ateneva
4/23/2017 - 9:13 AM

Re-filter and export your camera pic to PowerPoint slides

Re-filter and export your camera pic to PowerPoint slides

Sub Select_Actual()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'written by Angelina Teneva, 2014
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim Msg As Integer, Ans As Integer

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

Dim Country As Range
Dim Cell As Range

'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\Finance Package.pptm")

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

Set Country = ActiveSheet.Range("G7")

'***************************
For Each Cell In ActiveSheet.Range("BW8:BW24")
    Country = Cell.Value
    
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.Copy

    Select Case Country
        Case "Europe": PPpres.Slides(2).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "UK": PPpres.Slides(6).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "Germany": PPpres.Slides(10).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "Iberia": PPpres.Slides(14).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "Italy": PPpres.Slides(18).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "France": PPpres.Slides(22).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "BEL": PPpres.Slides(26).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "MEMA": PPpres.Slides(30).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "CEE": PPpres.Slides(34).Shapes.PasteSpecial ppPasteEnhancedMetafile
        Case "Russia": PPpres.Slides(2).Shapes.PasteSpecial ppPasteEnhancedMetafile
    End Select

Next Cell

PPpres.Save
PPpres.Close

End Sub