[英]Run time error 9: subscript out of range (error while pasting)
我是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
如果我對您的理解正確,則希望:
下面的代碼可以做到這一點:
'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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.