Question

我正在编写一个VBA脚本，其中必须移动鼠标光标并单击某个Javascript页面上的各个位置。这不是一个可以查看元素的简单Internet Explorer页面。因此，我使用硬编码方式移动了光标（例如SetCursorPos 50、200）。这样，脚本可以在我的计算机上运行，而不能在其他计算机上运行。

如何映射相对于屏幕分辨率的点以指向所有屏幕的相同位置？

源代码：

 ' Access the GetCursorPos function in user32.dll
  Declare Function GetCursorPos Lib "user32" _
  (lpPoint As POINTAPI) As Long
  ' Access the GetCursorPos function in user32.dll
  Declare Function SetCursorPos Lib "user32" _
  (ByVal x As Long, ByVal y As Long) As Long
  'Determine whether a key is up or down at the time the function is called
  Declare Function GetAsyncKeyState Lib "user32" _
  (ByVal vKey As Long) As Integer


  ' GetCursorPos requires a variable declared as a custom data type
  ' that will hold two integers, one for x value and one for y value
  Type POINTAPI
     X_Pos As Long
     Y_Pos As Long
  End Type


  ' Main routine to dimension variables, retrieve cursor position,
  ' and display coordinates
  Sub Get_Cursor_Pos()

  ' Dimension the variable that will hold the x and y cursor positions
  Dim Hold As POINTAPI

  ' Place the cursor positions in variable Hold
  GetCursorPos Hold

  ' Display the cursor position coordinates
  MsgBox "X Position is : " & Hold.X_Pos & Chr(10) & _
     "Y Position is : " & Hold.Y_Pos
  End Sub



 Sub AutomatePlmSearch()

   Dim p As POINTAPI

   Const Enter = "{ENTER}"
   Const Message = "Please enter the item number of the PLM BOM"


   'Open The Workarea dropdown
   p.X_Pos = 50
   p.Y_Pos = 100

   SetCursorPos p.X_Pos, p.Y_Pos
   Call LongPause

   'left click
   Call LeftClick

   'Select the Workarea Manager
   SetCursorPos 50, 200
   Call LongPause

   'left click
   Call LeftClick


   SetCursorPos 1360, 535
   Call ShortPause
   mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
   Call LongPause
   SetCursorPos 1360, 570
   Call ShortPause
   mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

   'left click
   Call LeftClick

   'Select SEARCH BY PARTS LIST
   Call ShortPause
   SetCursorPos 694, 572
   Call ShortPause

   'double click
   Call DoubleLeftClick

   'Close the Workarea Manager
   Call ShortPause
   SetCursorPos 1365, 368
   Call ShortPause

   'left click
   Call LeftClick

   'Go to the Item Number text field
   Call ShortPause
   SetCursorPos 90, 217
   Call ShortPause

   'left click
   Call LeftClick

   'Enter the PLM
   SendKeys (PLM_BOM_Number)
   SendKeys Enter

   'Call LongPause
   'Call GetPositionOnMouseClick

   'Select all the parts to be exported
   Call ShortPause
   SetCursorPos 54, 528
   Call ShortPause


   'left click
   Call LeftClick

 End Sub

Function LeftClick()
   'left click
   mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
   Application.Wait (Now + TimeValue("0:0:01"))
   mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

结束功能

函数DoubleLeftClick（） mouse_event MOUSEEVENTF_LEFTDOWN，0、0、0、0 Application.Wait（Now + TimeValue（“ 0：0：01”）/ 2） mouse_event MOUSEEVENTF_LEFTUP，0、0、0、0 mouse_event MOUSEEVENTF_LEFTDOWN，0、0、0、0 Application.Wait（Now + TimeValue（“ 0：0：01”）/ 2） mouse_event MOUSEEVENTF_LEFTUP，0、0、0、0 结束功能

将GetPositionOnMouseClick（）函数用作POINTAPI

Dim myPoint As POINTAPI
Dim l As Long
Do Until GetAsyncKeyState(vbKeyLButton)
    DoEvents
Loop

 l = GetCursorPos(myPoint)
 Debug.Print "x: " & myPoint.X_Pos & "y: " & myPoint.Y_Pos

结束功能

函数ShortPause（） Application.Wait（Now + TimeValue（“ 0：0：01”））结束功能

LongPause（）函数

相对于屏幕分辨率的VBA SetCursosPos

0 个答案: