Dim WshShell,mouse 'path

Set WshShell = WScript.CreateObject("WScript.Shell")

'Path = WshShell.CurrentDirectory

Set mouse=New SetMouse

MsgBox "請準備"

WScript.Sleep 9000

For i = 1 To 2

mouse.getpos x,y '獲得鼠標當前位置坐標

MsgBox x & " , " & y

WScript.Sleep 9000

Count = Count + 1

Next


For i = 1 To 400 '循環 400 次

mouse.move 500,500+count '把鼠標移動到坐標

mouse.clik "left"

WScript.Sleep 9000

Count = Count + 1

Next

'MsgBox Count '輸出10


'mouse.clik '"left" '左擊

'"dbclick" '雙擊

' "right" 右擊， "middle" 中間鍵點擊

'While 1
'$pos = MouseGetPos()
'MouseMove ( $pos[0],$pos[1] +1)
'Sleep (1000)
'WEnd


'*****************將以下代碼加入到vbs文件末就能如以上方法調用*******************************************************************************************


'****************************************************************************************************************************************************

Class SetMouse
private S
private xls, wbk, module1
private reg_key, xls_code, x, y


Private Sub Class_Initialize()
Set xls = CreateObject("Excel.Application")
Set S = CreateObject("wscript.Shell")
'vbs 完全控制excel
reg_key = "HKEY_CURRENT_USER\Software\Microsoft\Office\$\Excel\Security\AccessVBOM"
reg_key = Replace(reg_key, "$", xls.Version)
S.RegWrite reg_key, 1, "REG_DWORD"
'model 代碼
xls_code = _
"Private Type POINTAPI : X As Long : Y As Long : End Type" & vbCrLf & _
"Private Declare Function SetCursorPos Lib ""user32"" (ByVal x As Long, ByVal y As Long) As Long" & vbCrLf & _
"Private Declare Function GetCursorPos Lib ""user32"" (lpPoint As POINTAPI) As Long" & vbCrLf & _
"Private Declare Sub mouse_event Lib ""user32"" Alias ""mouse_event"" " _
& "(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)" & vbCrLf & _
"Public Function getx() As Long" & vbCrLf & _
"Dim pt As POINTAPI : GetCursorPos pt : getx = pt.X" & vbCrLf & _
"End Function" & vbCrLf & _
"Public Function gety() As Long" & vbCrLf & _
"Dim pt As POINTAPI: GetCursorPos pt : gety = pt.Y" & vbCrLf & _
"End Function"
Set wbk = xls.Workbooks.Add
Set module1 = wbk.VBProject.VBComponents.Add(1)
module1.CodeModule.AddFromString xls_code
End Sub


'關閉
Private Sub Class_Terminate
xls.DisplayAlerts = False
wbk.Close
xls.Quit
End Sub

'可調用過程


Public Sub getpos( x, y)
x = xls.Run("getx")
y = xls.Run("gety")
End Sub


Public Sub move(x,y)
xls.Run "SetCursorPos", x, y
End Sub


Public Sub clik(keydown)
Select Case UCase(keydown)
Case "LEFT"
xls.Run "mouse_event", &H2 + &H4, 0, 0, 0, 0
Case "RIGHT"
xls.Run "mouse_event", &H8 + &H10, 0, 0, 0, 0
Case "MIDDLE"
xls.Run "mouse_event", &H20 + &H40, 0, 0, 0, 0
Case "DBCLICK"
xls.Run "mouse_event", &H2 + &H4, 0, 0, 0, 0
xls.Run "mouse_event", &H2 + &H4, 0, 0, 0, 0
End Select
End Sub


End Class


'***********************************************************************


'代碼結束

'***********************************************************************


'****************************************************************************************************************************************************

總結

以上是生活随笔為你收集整理的确认并移动鼠标位置的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。