尝试在PowerPoint幻灯片中复制Excel范围和PasteSpecial时出错(使用延迟绑定)

我正在使用延迟绑定将ChartsRange从Excel复制到PowerPoint。

我收到以下错误:

在这里输入图像说明

在这行代码中:

 Set myShape = ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile, msoFalse) 

注意 :我使用Range.CopyShapes.PasteSpecial作为ppPasteEnhancedMetafile因为经过大量的试验和错误,它在PowerPoint中给出了最佳的分辨率。

注意#2 :使用这个PasteSpecial作为ppPasteEnhancedMetafile工作正常,当我使用早期绑定 。 由于我们有用户运行Office 2010,Office 2013和Office 2016(我不希望他们使用VB项目引用到PowerPoint库),所以必须切换到“晚期绑定”。

我的代码

 Option Explicit Public Sub UpdatePowerPoint(PowerPointFile) Dim ppProgram As Object Dim ppPres As Object Dim CurOpenPresentation As Object Dim ppSlide As Object Dim myShape As Object Dim SlideNum As Integer Dim StageStat As String On Error Resume Next Set ppProgram = GetObject(, "PowerPoint.Application") On Error GoTo 0 If ppProgram Is Nothing Then Set ppProgram = CreateObject("PowerPoint.Application") Else If ppProgram.Presentations.Count > 0 Then For Each CurOpenPresentation In ppProgram.Presentations ' loop through all open presnetations (check Full Name: Path and name) Dim CleanFullName As String * 1024 CleanFullName = Replace(CurOpenPresentation.FullName, "%20", " ") ' replace Sharepoint characters %20 with Space (" ") Dim comStr As String * 1024 comStr = CStr(PowerPointFile) If StrComp(comStr, CleanFullName, vbTextCompare) = 0 Then Set ppPres = CurOpenPresentation Exit For End If Next CurOpenPresentation End If End If If ppPres Is Nothing Then ' if One-Pager presentation was not found from all open presentations Set ppPres = ppProgram.Presentations.Open(PowerPointFile, msoFalse) End If ppProgram.Visible = True SlideNum = 1 Set ppSlide = ppPres.Slides(SlideNum) ' set the slide ' --- loop throughout the Slide shapes and search for the Shape of type chart , then delete the old ones For i = ppSlide.Shapes.Count To 1 Step -1 If ppSlide.Shapes.Item(i).HasChart Or ppSlide.Shapes.Item(i).Type = msoEmbeddedOLEObject Or ppSlide.Shapes.Item(i).Type = msoPicture Then ppSlide.Shapes.Item(i).Delete End If Next i ' copy range from Excel Sheet OnePgrSht.Range("A1:Q33").Copy ' ***** Error at the line below ***** Set myShape = ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile, msoFalse) ' Paste to PowerPoint ' Set Pasted Picture object properties: With myShape .LockAspectRatio = msoFalse .Width = ExcelPicObj_Width .Height = ExcelPicObj_Height .Left = ExcelPicObj_Pos_Left .Top = ExcelPicObj_Pos_Top .ZOrder msoSendToBack End With ppPres.Save OnePgrSht.Activate ' <-- restore mouse focus on "One-Pager" sheet Set ppSlide = Nothing Set ppPres = Nothing Set ppProgram = Nothing End Sub 

ppPasteEnhancedMetafile是一个PowerPoint常量,不能使用后期绑定。 这是因为后期绑定不包括定义此常量的PowerPoint库。

所以你必须使用

 Set myShape = ppSlide.Shapes.PasteSpecial(2, msoFalse) 

其中2 = ppPasteEnhancedMetafile。