Как решить Shapes.PasteSpecial: неверный запрос при вставке Bitmap?

Question

Я пытаюсь создать подпрограмму VBA для копирования некоторых таблиц из Excel и вставки их в мою презентацию PowerPoint в виде растрового изображения. Я пробовал разные способы, но я продолжаю получать эту ошибку: Shapes.PasteSpecial: Неверный запрос. Указанный тип данных недоступен. Я не уверен, как ее решить, так как для некоторых слайдов код работает, а для других - нет. Код в настоящее время выглядит следующим образом:

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