Не удается выполнить функцию однократного нажатия для заданных координат

#excel #vba #winapi

#excel #vba #winapi

Вопрос:

Я не могу нажимать на указанные координаты в коде следующим образом

 'Declare mouse events
    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 = amp;H2
    Public Const MOUSEEVENTF_LEFTUP = amp;H4
    Public Const MOUSEEVENTF_RIGHTDOWN As Long = amp;H8
    Public Const MOUSEEVENTF_RIGHTUP As Long = amp;H10
    'Declare sleep
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Sub SingleClick()
      mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
      mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    End Sub
    Public Sub CreateAWorkbook()
    
    Dim Asset_Id As String
    Dim Current_Mark As String
    Dim DateTimeStamp As String, WorkbookName As String
    
    SetCursorPos 481, 38
    SingleClick
    SetCursorPos 336, 69
    SingleClick
    
    Asset_Id = Range("F2").Value
    Current_Mark = Range("I2").Value
    
    If IsEmpty(Range("F2").Value) = False And IsEmpty(Range("I2").Value) = False Then
    MessageToDisplay = "The Asset id is : " amp; Asset_Id amp; " and current mark is: " amp; Current_Mark
    MsgBox (MessageToDisplay)
    Else
    MessageToDisplay = "The Asset id is not present"
    MsgBox (MessageToDisplay)
    
    End If
    
    
    End Sub
 

Прямо сейчас просто наведите курсор на координаты вместо щелчка. Кто-нибудь может помочь?
Изображение для отображения области щелчков

Ответ №1:

Я не могу воспроизвести вашу проблему.

  1. Вы должны подтвердить, что целевые координаты доступны для просмотра при выполнении CreateAWorkbook
  2. mouse_event заменено на SendInput .
  3. Вам не нужно использовать SetCursorPos , оба mouse_event и SendInput могут указывать координаты.

Вот использование в C / C :

mouse_event

 void mouseClick(int x, int y) {

    int fScreenWidth = GetSystemMetrics(SM_CXSCREEN);
    int fScreenHeight = GetSystemMetrics(SM_CYSCREEN);
    int dx = MulDiv(x, 65535, fScreenWidth);
    int dy = MulDiv(y, 65535, fScreenHeight);
    mouse_event(MOUSEEVENTF_ABSOLUTE | MOUSEEVENTF_LEFTDOWN| MOUSEEVENTF_MOVE, dx, dy, 0, 0);
    mouse_event(MOUSEEVENTF_ABSOLUTE | MOUSEEVENTF_LEFTUP| MOUSEEVENTF_MOVE, dx, dy, 0, 0);
}
 

SendInput

 void mouseClick(int x, int y) {
    int fScreenWidth = GetSystemMetrics(SM_CXSCREEN);
    int fScreenHeight = GetSystemMetrics(SM_CYSCREEN);
    int dx = MulDiv(x, 65535, fScreenWidth);
    int dy = MulDiv(y, 65535, fScreenHeight);
    INPUT Input[2];
    memset(Input, 0, sizeof(INPUT));
    Input[0].type = Input[1].type = INPUT_MOUSE;
    Input[0].mi.dx = Input[1].mi.dx = dx;
    Input[0].mi.dy = Input[1].mi.dy = dy;
    Input[0].mi.dwFlags = MOUSEEVENTF_ABSOLUTE | MOUSEEVENTF_LEFTDOWN | MOUSEEVENTF_MOVE;
    Input[1].mi.dwFlags = MOUSEEVENTF_ABSOLUTE | MOUSEEVENTF_LEFTUP | MOUSEEVENTF_MOVE;

    SendInput(2, Input, sizeof(INPUT));
}
 

Редактировать:

VBA: SendInput

 Public Type MouseInput
    dx As Long
    dy As Long
    mouseData As Long
    dwFlags As Long
    time As Long
    dwExtraInfo As LongPtr
End Type

Public Type tagInput
    type As Long
    mi As MouseInput
End Type
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)
Public Declare PtrSafe Function SendInput Lib "user32" (ByVal cInputs As Long, pInputs As tagInput, ByVal cbSize As Long) As Long
Public Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Declare PtrSafe Function MulDiv Lib "Kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Public Const MOUSEEVENTF_LEFTDOWN = amp;H2
Public Const MOUSEEVENTF_LEFTUP = amp;H4
Public Const MOUSEEVENTF_ABSOLUTE As Long = 32768 'Can not use amp;H8000, because it was < 0
Public Const MOUSEEVENTF_MOVE = amp;H1
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public Const INPUT_MOUSE = 0


Public Sub MouseClick(ByVal x As Long, ByVal y As Long)
    Dim fScreenWidth As Long
    Dim fScreenHeight As Long
    Dim dx As Long
    Dim dy As Long
    Dim ret As Long
    
    fScreenWidth = GetSystemMetrics(SM_CXSCREEN)
    fScreenHeight = GetSystemMetrics(SM_CYSCREEN)
    dx = MulDiv(x, 65535, fScreenWidth)
    dy = MulDiv(y, 65535, fScreenHeight)
    
    Dim MouseInput() As tagInput
    ReDim MouseInput(0 To 1) As tagInput
    
    MouseInput(0).type = INPUT_MOUSE
    MouseInput(0).mi.dx = dx
    MouseInput(0).mi.dy = dy
    MouseInput(0).mi.mouseData = 0
    MouseInput(0).mi.dwFlags = MOUSEEVENTF_ABSOLUTE   MOUSEEVENTF_LEFTDOWN   MOUSEEVENTF_MOVE
    MouseInput(0).mi.time = 0
    MouseInput(0).mi.dwExtraInfo = 0
    
    MouseInput(1).type = INPUT_MOUSE
    MouseInput(1).mi.dx = dx
    MouseInput(1).mi.dy = dy
    MouseInput(1).mi.mouseData = 0
    MouseInput(1).mi.dwFlags = MOUSEEVENTF_ABSOLUTE   MOUSEEVENTF_LEFTUP   MOUSEEVENTF_MOVE
    MouseInput(1).mi.time = 0
    MouseInput(1).mi.dwExtraInfo = 0
    
    
    ret = SendInput(2, MouseInput(0), LenB(MouseInput(0)))
    
End Sub

Private Sub UserForm_Click()
    MouseClick 481, 238
    MouseClick 336, 269
End Sub
 

mouse_event

 Public Sub MouseClick(ByVal x As Long, ByVal y As Long)
    Dim fScreenWidth As Long
    Dim fScreenHeight As Long
    Dim dx As Long
    Dim dy As Long
    
    fScreenWidth = GetSystemMetrics(SM_CXSCREEN)
    fScreenHeight = GetSystemMetrics(SM_CYSCREEN)
    dx = MulDiv(x, 65535, fScreenWidth)
    dy = MulDiv(y, 65535, fScreenHeight)
    
    mouse_event MOUSEEVENTF_ABSOLUTE   MOUSEEVENTF_LEFTDOWN   MOUSEEVENTF_MOVE, dx, dy, 0, 0
    mouse_event MOUSEEVENTF_ABSOLUTE   MOUSEEVENTF_LEFTUP   MOUSEEVENTF_MOVE, dx, dy, 0, 0
    
End Sub
 

Комментарии:

1. Да, целевые координаты доступны для кликабельности на одном листе Excel. Может, пожалуйста, дайте мне знать об использовании выше в VBA

2. Привет, mouse_event полезно, но я все равно не могу выполнить операцию щелчка с другой задачей. Пожалуйста, просмотрите мой код, там мне нужно показать окно сообщения после щелчка. Не могли бы вы помочь мне в этом?

3. mouse_event полезен, но все же я не могу выполнить операцию щелчка с другой задачей. я все еще не могу воспроизвести вашу проблему. Не могли бы вы использовать инструмент рисования для выполнения теста, чтобы увидеть, нарисованы ли точки. Кроме того, я обнаружил, что если excel не имеет фокуса при щелчке, первый щелчок сфокусирует только окно (не удалось щелкнуть по меню). Вы столкнулись с этой проблемой или можете добавить демонстрацию в формате gif?

4. Ву, правда, курсор фокусируется только на указанных координатах, а не щелкает по ним. Не могли бы вы мне помочь, чтобы я мог последовательно щелкнуть по указанным координатам и выполнить остальную часть задачи в коде VBA.

5. Попробуйте сосредоточиться на окне Excel, прежде чем нажимать. с такой функцией, как SetForegroundWindow