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

我对VBA比较陌生。我正在尝试以下VBA代码，但它抛出了一个错误：“运行时错误09:下标超出范围”。在代码的图1部分中尝试粘贴操作时发生此错误

有人能帮我弄清楚我哪里出了问题吗。我已经宣布了演示文稿/幻灯片等，但我仍然面临这个问题

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

---

如果我理解正确，您希望：

• 打开保存的演示文稿
• 从幻灯片2中删除“图片3”
• 从excel工作表复制图表/范围
• 将其粘贴到幻灯片2中
• 命名为“图片3”
• 在幻灯片上设置它的位置

下面的代码正是这样做的：

'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