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

Question

我对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 

Answer 1

如果我理解正确的话，你想：

• 打开保存演示文稿
• 删除“图3" 从幻灯片2
• 复制图表/范围从您的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