Question

我对VBA比较陌生。我尝试了以下VBA代码，但它抛出了错误：＆＃39;运行时错误09：下标超出范围＆＃39;。当我在代码的图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

如果我理解正确，你想：

打开已保存的演示文稿
从幻灯片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

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

1 个答案: