vba - 尝试在 PowerPoint 幻灯片中复制 Excel 范围和 PasteSpecial 时出错(使用后期绑定(bind))

Question

我正在使用后期绑定(bind)将图表和范围从Excel复制到PowerPoint。

我收到以下错误:

在这行代码:

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

注意:我使用 Range.Copy 和 Shapes.PasteSpecial 作为 ppPasteEnhancedMetafile 因为经过了很多次经过反复试验，它在 PowerPoint 中提供了最佳解决方案。

注意#2:当我使用早期绑定(bind)时，使用此PasteSpecial作为ppPasteEnhancedMetafile对我来说效果很好。由于我们有用户运行 Office 2010、Office 2013 和 Office 2016(并且我不希望他们使用 PowerPoint 库的 VB 项目引用)，我不得不切换到后期绑定(bind)。

我的代码

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 常量，使用后期绑定(bind)不可用。这是因为后期绑定(bind)不包括定义此常量的 PowerPoint 库。

所以你必须使用

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

其中 2 = ppPasteEnhancedMetafile。