如何解决Shapes.PasteSpecial:粘贴位图时请求无效

Question

我正在尝试创建一个VBA例程，从excel中复制一些表，并将它们作为位图粘贴到我的PowerPoint演示文稿中。我尝试了不同的方法，但我一直收到这个错误：形状。粘贴特殊：无效请求。指定的数据类型不可用。我不知道如何解决它，因为对于一些幻灯片，代码似乎有效，而对于其他幻灯片，代码则无效。目前的代码如下：

Set PowerPointApp = CreateObject("Powerpoint.application")
DestinationPPT = ("C:xxxxx.pptx")
PowerPointApp.Presentations.Open (DestinationPPT)
Set myPresentation = PowerPointApp.ActivePresentation
Set ArquivoAberto = ActiveWorkbook
Set mySlide = Nothing
Set myShape = Nothing
Final = 142
j = 5
For i = 9 To Final
Set mySlide = Nothing
Set myShape = Nothing
ArquivoAberto.Sheets("B. Metrics On").Range(Cells(i, 2), Cells(i + 6, 8)).Select
Selection.Copy
Set mySlide = myPresentation.Slides(j)
mySlide.Shapes.PasteSpecial DataType:=1
Selection.Clear
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Name = "CashOn"
j = j + 1
i = i + 6
Next
Set ArquivoAberto = Nothing
End Sub

如有任何帮助，我们将不胜感激。

Answer 1

我无法重现您的错误。在我的电脑上，它运行良好：/我认为发生这种情况时剪贴板是空的。复制后尝试使用DoEvents编写代码。也许这会奏效：

Set PowerPointApp = CreateObject("Powerpoint.application")
DestinationPPT = ("C:xxxxx.pptx")
PowerPointApp.Presentations.Open (DestinationPPT)
Set myPresentation = PowerPointApp.ActivePresentation
Set ArquivoAberto = ActiveWorkbook
Set mySlide = Nothing
Set myShape = Nothing
Final = 142
j = 5
For i = 9 To Final
Set mySlide = Nothing
Set myShape = Nothing
ArquivoAberto.Sheets("B. Metrics On").Range(Cells(i, 2), Cells(i + 6, 8)).Select
Selection.CopyPicture xlScreen, xlBitmap
DoEvents
Set mySlide = myPresentation.Slides(j)
mySlide.Shapes.PasteSpecial DataType:=1
DoEvents
Application.CutCopyMode = False
Selection.Clear
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
myShape.Name = "CashOn"
j = j + 1
i = i + 6
Next
Set ArquivoAberto = Nothing
End Sub