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

Question

我正在使用后期绑定将 Charts 和 Range 从 Excel 复制到 PowerPoint。

我收到以下错误：

在这行代码中：

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

注意：我使用 Range.Copy 和 Shapes.PasteSpecial 作为 ppPasteEnhancedMetafile 因为经过大量的试验和错误后它给出了最好的PowerPoint 中的分辨率。

注意 #2：当我使用 Early Binding[=39 时，将此 PasteSpecial 用作 ppPasteEnhancedMetafile 对我来说效果很好=].由于我们有用户 运行 Office 2010、Office 2013 和 Office 2016（而且我不希望他们玩 PowerPoint 的 VB 项目参考，因此我不得不切换到后期绑定图书馆）。

我的代码

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。