VBA：无法从剪贴板粘贴

Question

我正在尝试从Excel复制一系列单元格，并将其粘贴到具有原始格式的PowerPoint演示文稿（均为2016版）的幻灯片上。

我尝试过

Allg.Copy
mySlide2.Shapes.PasteSpecial DataType:=0
myPresentation.Slides(2).Shapes(3).Name = "AllgShape" 

并且它在大多数时间都有效，但并非总是如此。有时会发生以下运行时错误：

'-2147188160（80048240）'：Shapes.PasteSpecial：无效的请求。剪贴板为空或包含可能无法在此处粘贴的数据

因为（我认为）剪贴板未及时填充。因此，如果发生错误，我尝试这样做只是重复复制和粘贴过程：

ALLGCOPY:
  Allg.Copy
  On Error GoTo ALLGCOPY:
  mySlide2.Shapes.PasteSpecial DataType:=0
  myPresentation.Slides(2).Shapes(3).Name = "AllgShape"

似乎错误处理程序与我认为的不完全一样，因为有时在运行此代码时，它只会粘贴相同形状两次。

然后我尝试了

Allg.Copy
PowerPointApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
myPresentation.Slides(2).Shapes(3).Name = "AllgShape"

但是有时候，形状的名称分配存在问题，因为它粘贴得不够快。

所以我在粘贴后添加了一个计时器

Public Sub Warten(ByVal MilliSekunden As Double)
   Dim i    As Double
   Dim ENDE As Double

   ENDE = Timer + (MilliSekunden / 1000)

   Do While i < ENDE
      DoEvents
      i = Timer
   Loop
End Sub

但这是不可靠的，因为有时100毫秒就足够了，但是有时甚至2000毫秒还不够，我希望宏可以在大多数（也是较旧的）计算机上运行。

最好是我要使用错误处理程序，而不要使用计时器，因为它不可靠并且取决于CPU使用率。

有人可以告诉我为什么带有错误处理程序的代码不起作用，有时会粘贴相同形状两次吗？

谢谢

Answer 1

[需要回答的问题是“如何等待剪贴板中的数据？”和“我如何知道粘贴完成的时间”。对于第一个问题，基于this answer等，您可以这样做：

Option Explicit

Public Sub PasteSomeData()
   Dim i As Integer

   ClearClipboard
   Allg.Copy

   Do While isClipboardEmpty() And i < 5
      i = i + 1
      Application.Wait Now + TimeValue("00:00:01")
   Loop

   If Not isClipboardEmpty() Then
      mySlide2.Shapes.PasteSpecial DataType:=0
      myPresentation.Slides(2).Shapes(3).Name = "AllgShape"
   End If
End Sub

由于我们一直循环直到剪贴板中有数据，所以我们需要提供一种防止无限循环的机制。我选择尝试5次，每次尝试之间要间隔1秒。根据需要调整这些值。在一个模块中，我有以下代码：

Option Explicit

Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long

Public Function ClearClipboard()
   OpenClipboard 0&

   EmptyClipboard

   CloseClipboard
End Function

Public Function isClipboardEmpty() As Boolean
    OpenClipboard 0&

    isClipboardEmpty = (CountClipboardFormats() = 0)

    CloseClipboard
End Function

现在，关于第二个问题，我没有一个好的答案。您可能会像在问题中一样被迫停顿一段时间，并在评论中提出了建议。