尝试在PowerPoint幻灯片中复制Excel范围和PasteSpecial时出错（使用后期绑定）

Question

我正在使用Late Binding将Charts和Range从Excel复制到PowerPoint。

我收到以下错误：

在这行代码中：

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

注意：我使用Range.Copy和Shapes.PasteSpecial作为ppPasteEnhancedMetafile，因为在经过大量试验和错误后，它会在PowerPoint中提供最佳解决方案。< / p>

注意＃2 ：当我使用早期绑定时，使用此PasteSpecial作为ppPasteEnhancedMetafile对我来说很好。我不得不切换到Late Binding，因为我们有用户运行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

Answer 1

ppPasteEnhancedMetafile是PowerPoint常量，使用后期绑定不可用。这是因为后期绑定不包括定义此常量的PowerPoint库。

所以你必须使用

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

其中2 = ppPasteEnhancedMetafile。