PowerPoint VBA - 选择性粘贴（增强的图元文件）错误

Posted 2023-02-25

【中文标题】PowerPoint VBA - 选择性粘贴（增强的图元文件）错误

【英文标题】：PowerPoint VBA - Paste Special (Enhanced Metafile) bug

【发布时间】：2010-07-15 22:56:34

【问题描述】：

我正在使用 PowerPoint 2003 SP3 中的宏来查找 Excel 工作簿中的指定图表，将其复制，然后将其作为增强型图元文件粘贴到当前幻灯片中，最终使用以下代码行：

Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

只要它正常工作，我也会收到以下错误：

运行时错误'-2147188160 (80048240)'：
查看（未知成员）：请求无效。指定的数据类型不可用。

如果我结束宏并尝试手动将选择性粘贴为增强型元文件，我没有问题，所以剪贴板对象或 pastespecialtype 不是无效的。

有其他人经历过吗？您有解决方案或解决方法吗？ Google 搜索结果很少，也没有解决此错误的方法。

---

更新

一般代码如下：

Set presPPTCurrent = ActivePresentation
Set objXLApp = GetObject(, "Excel.Application")

''#Find the target chart and copy it to the clipboard
With objXLApp
    ''#This part works - if I go to Excel, I can see that the chart is copied
End With

''#Now paste in the chart as an Enhanced Metafile
presPPTCurrent.Application.Activate
Application.ActiveWindow.View.PasteSpecial DataType:=ppPasteEnhancedMetafile

请注意，这是在传递 Shape 的 Sub 中（传递的 Shape 用作在 Excel 中查找图表的参考）。我意识到只有当我尝试在另一个 Sub 中的 For Next 循环传递的多个形状上重用此 sub 时，它才会出错。

但是，如果我通过另一个 Sub 将单个 Shape 传递给该 Sub，然后重新运行传递多个 Shapes 的 Sub，它运行正常。

---

解决方案

根据 Otaku 的说法，宏正在失去对滑动窗格的关注。告诉它重新选择幻灯片窗格解决了这个问题。

Application.ActiveWindow.Panes(2).Activate

【问题讨论】：

问题很可能是失去对 PowerPoint 的关注，因此没有ActiveWindow。如果您发布有关从 Excel 抓取的代码，这可能会有所帮助。

@Otaku - 感谢您的意见。我试图找出再次激活窗口的正确方法。假设这是问题所在，我仍然没有成功。再次感谢。非常感谢。

我自己试过了，Activate 方法还是随机出错。我使用了 Kuba 的建议，效果很好。

【参考方案1】：

这可能是焦点丢失，在 Excel 和 PowerPoint 之间切换会导致 PowerPoint 失去焦点，因此没有 ActiveWindow 供 PowerPoint 粘贴，或者 ActiveWindow 在 PowerPoint 中变为不同的 Pane，例如幻灯片排序器或备注窗格。

【讨论】：

@varient：知道了。在提供任何建议之前，我将不得不尝试复制该问题。给我一点时间 - 我现在在夏威夷 :)

谢谢。请张贴您的“注意力不集中”消息作为答案，以便我可以将这一点归功于您。你太棒了。解决方案是添加一行，告诉它重新选择主窗口。它看起来像是要进入幻灯片分类器窗格或注释窗格。 Application.ActiveWindow.Panes(2).Activate

@variant：知道了，很高兴听到发现并修复了问题。我已经改变了上面的答案。

【参考方案2】：

我遇到了同样的问题。我有将大量图表导出到 PowerPoint 的宏。但是一些复制粘贴操作以与上述相同的错误结束（运行时错误'-2147188160（80048240）':)

我意识到 PasteSpecial 错误不是由于失去焦点，而是由于剪贴板丢失。

因此，解决方案是将区域重新复制到剪贴板，如下所示：

On Error GoTo paste_error
ppSlide.Shapes.PasteSpecial(2, link:=RangeLink).Select
...
paste_error:
    Worksheets(SheetName).Range(RangeName).copy
    Resume

也许这对某人有帮助...

【参考方案3】：

我遇到了同样的错误，并在这里尝试了许多解决方案。最终为我工作的是非常简单的事情。我认为它之所以有效，是因为第一行保存了对幻灯片的引用。粘贴选项可以是 EnhancedMetaFile 而不是 Bitmap。

    Sub Macro()
       Set sld = Application.ActiveWindow.View.Slide
       With GetObject(, "Excel.Application")
           .Workbooks(1).Sheets(1).Shapes(1).Copy
       End With

       sld.Shapes.PasteSpecial DataType:=ppPasteBitmap
   End Sub