运行时错误9：下标超出范围（粘贴时出错）

Question

I'm relatively new to VBA. I'm trying out the following VBA code but its throwing an error: 'Runtime error 09: subscript out of range'. This error occurs when i'm trying the paste operation in Graph 1 section of the code..

can someone help with figuring out as to where i'm going wrong. I have declared the presentation/slide etc. still i'm facing this problem..

Sub UK()

Dim oPPTApp As PowerPoint.Application
 Dim oPPTFile As PowerPoint.Presentation
 Dim oPPTShape As PowerPoint.Shape
 Dim oPPTSlide As PowerPoint.Slide
 Dim SlideNum As Integer
 Dim mycells As Range
 Set oPPTApp = CreateObject("PowerPoint.Application")
 srcdir = "D:\WBR\Week 2"
 srcfile = srcdir & "\" & Dir(srcdir + "\*.pptx")
 Set oPPTFile = oPPTApp.Presentations.Open(srcfile)
 Set oPPTSlide = oPPTFile.Slides(2)


' for graph 1
 Set oPPTShape = oPPTFile.Slides(2).Shapes("Picture 3") 
 oPPTShape.Delete

 ThisWorkbook.Sheets("New Charts").Activate
 Sheets("New Charts").Shapes.Range(Array("Group 21")).Select
 Selection.CopyPicture

 oPPTApp.ActivePresentation.Slides(2).Select 
 Set Picture = oPPTSlide.Shapes.Paste
 Picture.Name = "Picture 3" 

With oPPTApp.ActivePresentation.Slides(2).Shapes("Picture 3") 
  .Top = Application.InchesToPoints(3)
  .Left = Application.InchesToPoints(0.22)
End With

Answer 1

If I understand you correctly, you want to:

• Open a saved presentation
• Delete "Picture 3" from Slide 2
• Copy Chart/Range from your excel sheet
• Paste it in Slide 2
• Name it as "Picture 3"
• Set it's position on the slide

Well the below code does exactly that:

'Make Sure to load the PowerPoint Object Library
'Tools ---> References ---> Microsoft PowerPoint xx.x Object Library

    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim pptSlide As PowerPoint.Slide
    Dim objChart As Chart

    Set pptApp = New PowerPoint.Application

    'presentation path here
    srcdir = "C:\"
    Set pptPres = pptApp.Presentations.Open(srcdir & "Presentation" & ".pptx")

    Set pptSlide = pptPres.Slides(2)

    For j = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(j)
    If .Name = "Picture 3" Then
    .Delete
    End If
        End With
    Next j

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Change "Chart 1" to the name of your chart if you are copying a chart
    Worksheets("New Charts").ChartObjects("Chart 1").Activate
    Set objChart = Worksheets("New Charts").ChartObjects("Chart 1").Chart
    objChart.CopyPicture

    'If you are copying a range of cells then use
    Worksheets("New Charts").Range("A1:A10").Copy

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Set MyPic = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile)

    With MyPic
    .Name = "Picture 3"
    End With

    With pptSlide.Shapes("Picture 3")
    .Top = Application.InchesToPoints(3)
    .Left = Application.InchesToPoints(0.22)
    End With

    'use this line to set focus to slide 2 if you want to
    pptPres.Slides(2).Select

    pptPres.Save 'use this line to save if you want to

    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing