excel - VBA:从剪贴板粘贴不可靠

Question

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

我试过了

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

它大部分时间都有效，但并非总是如此。
以下运行时错误不时发生:

'-2147188160 (80048240)': Shapes.PasteSpecial: Invalid request. Clipboard is empty or conains data which may not be pasted here

因为(我认为)剪贴板没有及时填充。因此，如果发生错误，我尝试这样做只是重复复制和粘贴过程:

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

似乎错误处理程序并不完全符合我的想法，因为有时它只是在运行此代码时粘贴相同的形状 2 次。

然后我尝试了

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 使用率。

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

编辑:
显然我对错误处理程序如何工作的理解是不够的。可以通过相应地使用错误处理程序来解决我的问题。

谢谢

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

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