将Excel工作表粘贴到PowerPoint演示文稿

我已经在输出工作表中测试了代码,它可以正常工作。

但是,当宏在Excel模板中执行为real时,它会失败。

请注意,objPPT是在grandFinale()的宏上游定义的。

Sub grandFinale()

Dim PPPres As PowerPoint.Presentation 
Dim PPSlide As PowerPoint.Slide
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long

Set objPPT = GetObject(, "Powerpoint.Application")
Set PPPres = objPPT.ActivePresentation
Set PPSlide = PPPres.Slides(objPPT.ActiveWindow.Selection.SlideRange.SlideIndex)

'declare pp slides
MySlideArray = Array(13, 14, 15, 16, 17, 18, 19, 20, 21, 22)

'declare excel ranges
MyRangeArray = Array(Sheet2.Range("A6:C18"), Sheet2.Range("A21:C33"), _
    Sheet2.Range("A36:C48"), Sheet2.Range("A51:C63"), Sheet2.Range("A66:C78"), _
   Sheet2.Range("A81:C93"), Sheet2.Range("A96:C108"), Sheet2.Range("A111:C123"), Sheet2.Range("A126:C138"), Sheet2.Range("A141:C153"))

'excel to powerpoint paste loop
For x = LBound(MySlideArray) To UBound(MySlideArray)
MyRangeArray(x).Copy
Set shp = PPPres.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)
'adjust images
With PPPres.PageSetup
    shp.Left = (.SlideWidth \ 2) - (shp.Width \ 2)
    shp.Top = (.SlideHeight \ 2) - (shp.Height \ 2)
End With

Next x
Application.CutCopyMode = False
End Sub