Excel VBA Sendkeys 没有延迟
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21387812/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA Sendkeys without delay
提问by dcampezano
I'm trying to copy some cells from excel to another Windows application so fast as possible using Sendkeys. If I don't use "wait", Sendkeys fails. And if use it, Sendkeys run slowly and I need it in full speed, realtime if possible. Anyone can help me? Sorry for my English, I'm a brazilian student. Thank you
我正在尝试使用 Sendkeys 尽可能快地将某些单元格从 excel 复制到另一个 Windows 应用程序。如果我不使用“等待”，Sendkeys 就会失败。如果使用它，Sendkeys 运行缓慢，我需要它全速运行，如果可能的话。任何人都可以帮助我吗？对不起我的英语，我是巴西学生。谢谢
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Private Sub SingleClick()
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Private Sub DoubleClick()
'Simulate a double click as a quick series of two clicks
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Private Sub RightClick()
'Simulate a right click
mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_RIGHTTUP, 0, 0, 0, 0
End Sub
Sub Bot?o1_Clique()
'copy b2 and past in a specific area (another windows application)
Range("B2").Copy
SetCursorPos 765, 70
SingleClick
Application.SendKeys "^v"
Application.Wait (Now + 0.000007) ' It is the faster I can use but it's not enough
Range("B3").Copy
SetCursorPos 765, 80
SingleClick
Application.SendKeys "^v"
Application.Wait (Now + 0.000007)
Range("B4").Copy
SetCursorPos 765, 90
SingleClick
Application.SendKeys "^v"
End Sub
回答by Seth
While this likely isn't the best way to perform real-time trading, I think you can modify your SendKey statement to include the wait. I believe this Application.SendKeys "^v", Truewill force your code to pause for as long as it takes the command to execute, which might be faster than what you've coded.
虽然这可能不是执行实时交易的最佳方式，但我认为您可以修改 SendKey 语句以包含等待。我相信这Application.SendKeys "^v", True将迫使您的代码在执行命令时暂停，这可能比您编写的代码更快。
回答by Siddharth Rout
Don't use SendKeys. They are highly unreliable. Use the FindWindow/FindWindowEx/SendMessageAPI
不要使用 SendKeys。他们非常不可靠。使用FindWindow/ FindWindowEx/ SendMessageAPI
See THISexample where I have demonstrated on how to paste to a 3rd Party Application.
请参阅此示例，其中我演示了如何粘贴到第 3 方应用程序。
Based on that here is a simple example on how to paste from Excel to a 3rd party App.
基于此，这是一个关于如何从 Excel 粘贴到 3rd 方应用程序的简单示例。
Sample Code (UNTESTED)
示例代码（未经测试）
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Const WM_PASTE As Long = &H302
Sub Bot?o1_Clique()
Dim Ret
Dim i As Long
'~~> Change "BLAHBLAH" to the caption of the 3rd party app.
Ret = FindWindow(vbNullString, "BLAHBLAH")
If Ret <> 0 Then
'~~> Change "BLAHBLAH" to the type of textbox
'~~> Assuming that you want to paste to textbox else change it
Ret = FindWindowEx(Ret, ByVal 0&, "BLAHBLAH", vbNullString)
If Ret <> 0 Then
'~~> Looping through only 5 cells
'~~> Change as applicable
For i = 1 To 5
ThisWorkbook.Sheets("Sheet1").Range("B" & i).Copy
'~~> Paste
SendMessage Ret, WM_PASTE, 0, ByVal 0
DoEvents
Next i
Else
Debug.Print "TextBox in 3rd Party Application Not Found"
End If
Else
Debug.Print "3rd party Application Not Found"
Exit Sub
End If
End Sub
