如何强制剪贴板在 VBA 中更新

Question

我每天必须完成一项任务。它涉及将信息从 excel 复制到公司软件中。我对这个特定的公司软件没有任何控制权。我正在尝试使任务自动化。它涉及将选定的单元格复制到剪贴板，然后通过公司软件点击 9 次鼠标，每次点击后暂停约半秒。

一切似乎都有效，除了最后一步。我收到一条消息，指出剪贴板中没有任何内容。但是一旦宏退出，信息就在剪贴板中。我将宏暂停了 30 秒，以确保我没有急于使用剪贴板。直到宏完成后，它仍然没有将剪贴板识别为已满。

就好像 range.copy 复制到剪贴板但直到宏完成后才提交更改。在宏完成之前，它们不会最终确定。

我不知道我是否遗漏了一些命令，例如：clipboard.acceptchanges 或 clipboard.finalize 或 clipboard.refresh。我不确定我错过了什么。似乎其他人也有类似的问题是由剪贴板的时间延迟引起的，但正如我所说，这对我来说不仅仅是一个时间延迟问题。无论我给它多少时间，它都会发生。

谢谢。

Worksheets("writeorder").Range("M" & firstrow & ":M" & lastrow).Copy
Sleep 500
Call transactionclicksworkcomp


Sub transactionclicksworkcomp()


SetCursorPos 517, 1059 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 500

SetCursorPos 954, 33 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 500

SetCursorPos 659, 1029 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 500

SetCursorPos 588, 898 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 1200

SetCursorPos 767, 895 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 1200

SetCursorPos 705, 718 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 1200

SetCursorPos 1668, 889 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 1200

SetCursorPos 1852, 897 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 1200

SetCursorPos 1852, 885 'x and y position
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

Sleep 3000

End Sub

最后一次点击是在我的工作应用程序中的粘贴按钮上，该按钮从剪贴板中检索信息。宏单击粘贴，软件向我发送一条错误消息（空剪贴板）。但是当我在宏完成后直接点击按钮时，信息粘贴正确。

Answer 1

在这种情况下首先要尝试的是

DoEvents

，像这样：

Worksheets("writeorder").Range("M" & firstrow & ":M" & lastrow).Copy
DoEvents
Sleep 500

它允许 Excel 在剩下的事情发生之前赶上。

Answer 2

这对我有用，但它与您发布的代码并没有什么不同，除了我用它在 Excel 中点击：

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4

Sub transactionclicksworkcomp()
    'SetClipText "Hello" 'pastes OK
    Range("L1:L10").Clear
    Range("A1:A10").Copy
    
    LeftClickAndWait 2220, 360, 500
    LeftClickAndWait 2236, 400, 500
    
    ActiveSheet.Paste Destination:=Range("L1") 'pastes OK
End Sub

Sub LeftClickAndWait(xPos, yPos, mSec)
    SetCursorPos xPos, yPos 'x and y position
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    Sleep 3000
End Sub

您可以尝试设置剪贴板文本内容（代替复制范围）并查看是否有任何不同。

Answer 3

如果

DoEvents

不起作用，则另一种允许 Excel“赶上”的方法是使用

Application.OnTime

安排第二个宏。

Sub FirstPart()
    'Yadayadayada
    'Copy cells to clipboard
    Worksheets("writeorder").Range("M" & firstrow & ":M" & lastrow).Copy
    'Schedule part 2 to happen after this macro ends
    Application.OnTime Now(), "SecondPart"
End Sub

Sub SecondPart()
    'This will start immediately, but the previous Macro did finish first
    Call transactionclicksworkcomp
    'et cetera, et cetera
End Sub