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

需要回答的问题是 "How do I wait until the clipboard has data?" 和 "How do I know when pasting is complete"。对于第一个问题，基于 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

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

Answer 2

您的错误捕获想法是正确的。以下是重复等待时间直到不再生成错误的方法：

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

TooFast:
  Warten
  Resume TryPaste
End Sub

VBA: 从剪贴板粘贴不可靠

VBA: pasting from clipboard unreliable

error-handling

excel

powerpoint

vba

paste