Question

我正在尝试使用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

Answer 1

虽然这可能不是执行实时交易的最佳方式，但我认为您可以修改您的SendKey语句以包含等待。我相信这个Application.SendKeys "^v", True会强制你的代码暂停，只要它执行命令，这可能比你编码的更快。

Answer 2

不要使用SendKeys。它们非常不可靠。使用FindWindow / FindWindowEx / SendMessage API

请参阅我已演示如何粘贴到第三方应用程序的THIS示例。

基于此，这是一个关于如何从Excel粘贴到第三方应用程序的简单示例。

示例代码（ 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

Excel VBA Sendkeys没有延迟

2 个答案: