Excel to PowerPoint vba Oddities

[ddmx]

Hello,

Below is my code. It takes a range with a few charts in excel, copies it, and pastes it into powerpoint starting with the 2nd slide (first and last are predefined header slides). If you run this code straight through, it gives an error on

"ShapeRange (unknown member) : Invalid Request. To select a shape, its view must be active"

pptSlide.Shapes.PasteSpecial(DataType:=ppPasteBitmap).Select

Excel somehow has already pasted the shape onto slide 2 at this point, yet has failed to select slide 2 in the active powerpoint presentation.

If I step through the code one step at a time, there are no errors given and it works as needed. Only when running it does it produce this error. Any help would be much appreciated. Thanks.

Sub exportPP1()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim LTSheets As Integer
Dim LTPath As String
Dim LTBook As String
Dim LTTemp As String
Dim i As Integer
LTSheets = Application.Sheets.Count
LTPath = ActiveWorkbook.Path
LTBook = ActiveWorkbook.Name
If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application
pptApp.Visible = True
pptApp.Presentations.Open FileName:=LTPath & "\LT_Temp.ppt"
Set pptPres = pptApp.ActivePresentation
LTTemp = pptPres.Name
'i = 1
'Do While i < LTSheets
'    i = i + 1
For i = 2 To LTSheets
    Set pptSlide = pptApp.Presentations(LTTemp).Slides.Add(i, ppLayoutBlank)
    pptApp.Presentations(LTTemp).Slides(i).Select
    With ActiveSheet
        If .Name = "GPS_Data" Then
            Application.Sheets(i).Activate
            .Pictures.Select
            .Pictures.Copy
            pptApp.ActivePresentation.Slides(i).Select
            pptSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
            pptApp.ActiveWindow.Selection.ShapeRange.Width = 720
            pptApp.ActiveWindow.Selection.ShapeRange.Top = 42
            pptApp.ActiveWindow.Selection.ShapeRange.Left = 0
        Else
            Application.Sheets(i).Activate
            Range("A1").Select
            Range("A1:AA39").Copy
            pptApp.Presentations(LTTemp).Slides(i).Select
            pptSlide.Shapes.PasteSpecial(DataType:=ppPasteBitmap).Select
            pptApp.ActiveWindow.Selection.ShapeRange.Width = 720
            pptApp.ActiveWindow.Selection.ShapeRange.Top = 42
            pptApp.ActiveWindow.Selection.ShapeRange.Left = 0
        End If
    End With
Next i
End Sub