how to select specific slide via VBA - vba

Question

I have an Excel with Macro which should:
toggle to active PPT
select slide "X" and delete graphs
Go to Tab "X" in excel
grab new Graph
Paste onto the "X" slide
repeat 5 times
here is the code I've compiled so far:
Dim PPT As Object
Dim rng As Object
Dim rng1 As Object
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim ActivePresentation As Object
'Copy Range from Excel
Set rng = Sheet3.ChartObjects("Chart 6")
Set rng1 = Sheet3.ChartObjects("Chart 7")
Set rng2 = Sheet3.ChartObjects("Chart 8")
Set PPT = CreateObject("PowerPoint.Application")
With PPT
.Visible = True
.WindowState = 1
.Activate
End With
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Set myPresentation = PowerPointApp.Presentations.Add *this should not say add as it adds a slide,but no luck with any other commands*
' PowerPointApp.Presentations.Add
Set mySlide = myPresentation.Slides.Add(1, 11) *this should not say add as it adds a slide,but no luck with any other commands*
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.Left = 20
myShape.Top = 152
rng1.Copy
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = 486
myShape.Top = 152
Set mySlide = myPresentation.Slides.Add(2, 11) '11 = ppLayoutTitleOnly
etc..
End Sub
this creates a new PPT and add slides to the new ppt, have tried a numerous helps and web pages but unfortunately was not able to find a piece of code which would tackle this problem. Would be much appreciated if you could advise or point me to the correct help or tutorial which would be possible to solve this issue with.

Answer 1

code is based on the following assumptions from your statement
Already have a presentation open
want to copy two or three charts from each sheets, starting from Sheets(2) to Sheets(5) to slides 2 to 5 respectively as shown below.
Code may be modified to your requirement
Sub AddtoOpenPPT()
Dim PPT As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShape As PowerPoint.Shape
Dim Fname As String
Dim sld As Long, i As Long, ObjNo As Long
Dim Rng(0 To 9) As Object
Set Rng(0) = Sheet3.ChartObjects("Chart 6")
Set Rng(1) = Sheet3.ChartObjects("Chart 7")
Set Rng(2) = Sheet3.ChartObjects("Chart 8")
Set Rng(3) = Sheet3.ChartObjects("Chart 5")
Set Rng(4) = Sheet1.Range("b4:j14")
Set Rng(5) = Sheet1.Range("A4:l4", "A15:j19")
Set Rng(6) = Sheet4.ChartObjects("Chart 13")
Set Rng(7) = Sheet4.ChartObjects("Chart 15")
Set Rng(8) = Sheet4.ChartObjects("Chart 17")
Set Rng(9) = Sheet4.ChartObjects("Chart 19")
Set PPT = GetObject(class:="PowerPoint.Application")
Set myPresentation = PPT.ActivePresentation
ObjNo = 0
For sld = 2 To 5
Set mySlide = myPresentation.Slides(sld)
For i = mySlide.Shapes.Count To 1 Step -1
mySlide.Shapes(i).Delete
Next
For i = 1 To 3
Rng(ObjNo).Copy
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Left = IIf(i Mod 2 = 1, 20, 486)
myShape.Top = IIf(i < 3, 50, 200)
ObjNo = ObjNo + 1
If ObjNo > UBound(Rng) Then Exit For
Next
If ObjNo > UBound(Rng) Then Exit For
Next sld
End Sub