как выбрать конкретный слайд через VBA

Question

У меня есть Excel с макросом, который должен: переключиться на активный PPT выберите слайд «X» и удалите графики Перейти на вкладку "X" в Excel захватить новый график Вставить на слайд "X" повторить 5 раз

вот код, который я скомпилировал до сих пор:

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

это создает новый PPT и добавляет слайды в новый ppt, пробовал множество справок и веб-страниц, но, к сожалению, не смог найти кусок кода, который бы решал эту проблему. Буду очень признателен, если вы сможете посоветовать или указать мне правильную помощь или учебник, с помощью которого можно решить эту проблему.

Answer 1

код основан на следующих предположениях из вашего заявления

1. Уже открыта презентация
2. хотите скопировать две или три диаграммы из каждого листа, начиная с листов (2)на листы (5) на слайды 2–5 соответственно, как показано ниже.

Код может быть изменен по вашему требованию

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