XY Coordinate Excel VBA

Posted by Nonaluuluu on Wednesday, January 20, 2021 · Leave a Comment

The below Excel file will give you the XY coordinates in Excel VBA based on where your mouse is positioned on the screen. The more you go to the right or down the higher the X and Y numbers become. This is useful because of my second file much further down on the page. This second file much further down on the page enables you to control mouse left clicks, right clicks, typing, copying and pasting into and from browsers with Excel VBA. (I have a second version of file one with the 64 bit PTRSAFE word below too so that it works on Microsoft Office 2019 and Office 365 subscriptions. All VBA doesn't change as time goes on, but for this particular DECLARE function it does.) The best program is the last one at the bottom of the article.

How to check Excel Version:

Press File –> Press Account –> Look below:

Animated GIF of program (MouseMove file below). Notice how as I drag my mouse around the screen, I get live XY coordinates of where the mouse cursor is on my screen.

Needed Tools in Visual Basic Editor (See Lesson 1 in Main VBA Tutorials on my Youtube if you don't know how to access:)

File 1 XY Coordinates Excel VBA (choose the 2nd file if using Excel 2019/Microsoft 365):

MouseMove-1 Download

MouseMove-Windows-2019-Microsoft-365-64-Bit-uses-PTRSAFE Download

VBA code for File 1 above if you want to type it out…can add PTRSAFE after the 4 Declares at the top if Microsoft Office 2019 or later.

Private Declare Function setcursorpos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal swextrainfo As Long)
Private Const mouseeventf_leftdown = &H2
Private Const mouseeventf_leftup = &H4
Private Const mouseeventF_Rightdown As Long = &H8
Private Const mouseeventF_rightup As Long = &H10

Declare Sub sleep Lib "kernel32" (ByVal dwmilliseconds As Long)

Public Declare Function GetCursorPos Lib "user32" (lpPoint As PointAPI) As Long
Public Type PointAPI
x As Long
y As Long
End Type

Sub MouseMove()
Dim lngCurPos As PointAPI
Dim startTime As Double
Dim SecondsElapsed As Double
Dim MinutesElapsed As String

startTime = Timer
Starttime1 = Timer
GetCursorPos lngCurPos
x2 = lngCurPos.x
y2 = lngCurPos.y

Worksheets("Sheet1").Range("B1:B6").Value = ""
Worksheets("Sheet1").Range("A1").Value = "Cursor Position"
Worksheets("Sheet1").Range("A2").Value = "Time Elapsed"
Worksheets("Sheet1").Range("A3").Value = "Seconds Elapsed"
Worksheets("Sheet1").Range("A4").Value = "Time Remaining"
Worksheets("Sheet1").Range("A5").Value = "Times Activated"
Worksheets("Sheet1").Range("A6").Value = "Total Run Time"
Worksheets("Sheet1").Range("A7").Value = "Time to Activate"
Worksheets("Sheet1").Range("B4").Interior.ColorIndex = xlNone
Worksheets("Sheet1").Range("B7").Interior.ColorIndex = 6
Worksheets("Sheet1").Range("A1:B7").Borders.LineStyle = xlContinuous
Worksheets("Sheet1").Columns("A").ColumnWidth = 21
Worksheets("Sheet1").Columns("B").ColumnWidth = 15
Worksheets("Sheet1").Columns("B").HorizontalAlignment = xlCenter
If Worksheets("sheet1").Range("B7").Value = "" Then
    Worksheets("Sheet1").Range("B7").Value = "12:01:00 AM"
End If
Worksheets("Sheet1").Range("B7").NumberFormat = "hh:mm:ss"

SecondsToActivate = Worksheets("sheet1").Range("B7").Value
SecondsToActivate = Hour(SecondsToActivate) * 3600 + Minute(SecondsToActivate) * 60 + Second(SecondsToActivate)

counter = 0

Do

DoEvents

GetCursorPos lngCurPos
x1 = lngCurPos.x
Y1 = lngCurPos.y

If x1 <> x2 Or Y1 <> y2 Then
    startTime = Timer
    Worksheets("sheet1").Range("B4").Interior.ColorIndex = xlNone
End If

SecondsElapsed = Round(Timer - startTime, 2)
MinutesElapsed = Format(((Timer - startTime) - 0.5) / 86400, "hh:mm:ss")

Worksheets("Sheet1").Range("B1").Value = "X: " & lngCurPos.x & " Y: " & lngCurPos.y
Worksheets("Sheet1").Range("B2").Value = MinutesElapsed
Worksheets("Sheet1").Range("B3").Value = SecondsElapsed
Worksheets("Sheet1").Range("B4").Value = Format(((SecondsToActivate - SecondsElapsed) + 0.5) / 86400, "hh:mm:ss")
Worksheets("Sheet1").Range("B5").Value = counter
Worksheets("Sheet1").Range("B6").Value = Format(((Timer - Starttime1) - 0.5) / 86400, "hh:mm:ss")

If SecondsElapsed < SecondsToActivate * 0.7 Then
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.7 And SecondsElapsed < SecondsToActivate * 0.8 Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 6
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.8 And SecondsElapsed < SecondsToActivate * 0.9 Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 46
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.9 And SecondsElapsed < SecondsToActivate * 0.95 Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.95 Then
    If SecondsElapsed Mod 2 <> 0 Then
        Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3
        Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255)
    End If
End If

If SecondsElapsed >= SecondsToActivate Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = xlNone
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
    For I = 1 To 500
        For J = 1 To 100
            setcursorpos x1 + J, Y1
        Next J
        For J = 99 To 0 Step -1
            setcursorpos x1 + J, Y1
        Next J
    Next I
    
mouse_event mouseeventf_leftdown, 0&, 0&, 0&, 0&
sleep 100
mouse_event mouseeventf_leftup, 0&, 0&, 0&, 0&
sleep 100
SendKeys "(NUMLOCK)", True
sleep 100
SendKeys "(NUMLOCK)", True
sleep 100
startTime = Timer
counter = counter + 1
End If

GetCursorPos lngCurPos
x2 = lngCurPos.x
y2 = lngCurPos.y
 
 Loop
 

    







End Sub

File 2: Control Mouse Clicks and Typing into browsers. The program opens up Stocktwits, takes screenshots of the trending Stocktwits ticker stock symbols, and then posts them to Twitter. My screensize is different than yours, so obviously you can adjust using the XY coordinate to plan where the XY coordinates are on your screen.

Tools in Visual Basic Editor that you need to enable:


Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move



Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Declare PtrSafe Function SetCursorPos Lib "User32.dll" (ByVal X As Integer, ByVal Y As Integer) As Long
Public Declare PtrSafe Function GetCursorPos Lib "User32.dll" (ByRef lpPoint As POINTAPI) As Long
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 Long)





Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
  bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Const VK_SNAPSHOT = &H2C


Private Sub Example2()
 

 
Dim CurrentPosition As POINTAPI

Dim goku As Double
goku = 1
Do Until goku > 10000000

    
    
Dim vPID As Variant
'Variation 1:
vPID = Shell("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -URL http://stocktwits.com/", vbNormalFocus)
Application.Wait (Now + TimeValue("00:00:05"))
    
SetCursorPos 200, 200 'x and y position
 Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    
SetCursorPos 770, 115 'x and y position

  keybd_event VK_SNAPSHOT, 1, 0, 0
  
  Application.Wait (Now + TimeValue("00:00:01"))
    

'Tools --> References Microsoft Scripting Runtime  Reference
Dim fso As New FileSystemObject, aFile As File

'deletes the previous screenshot file called Untitled.png
With New FileSystemObject
    If .FileExists("C:\Users\18622\OneDrive\Desktop\Untitled.png") Then
        .DeleteFile ("C:\Users\18622\OneDrive\Desktop\Untitled.png")
    End If
End With

'Source: https://wordmvp.com/FAQs/MacrosVBA/PrtSc.htm takes a screenshot of screen
  

    


'Variation 1:
vPID = Shell("C:\WINDOWS\system32\mspaint.exe", vbNormalFocus)

Application.Wait (Now + TimeValue("00:00:02"))
SetCursorPos 770, 550 'x and y position
 Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.Wait (Now + TimeValue("00:00:01"))



Application.SendKeys ("^v")
Application.Wait (Now + TimeValue("00:00:01"))
SetCursorPos 130, 60 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.Wait (Now + TimeValue("00:00:01"))

SetCursorPos 800, 320 'x and y position
 Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
SetCursorPos 1000, 355 'x and y position
 Call GetCursorPos(CurrentPosition)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
 
Application.SendKeys ("^c")
Application.SendKeys ("^v")

''2
SetCursorPos 130, 60 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.Wait (Now + TimeValue("00:00:01"))

SetCursorPos 976, 320 'x and y position
 Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
SetCursorPos 1170, 355 'x and y position
 Call GetCursorPos(CurrentPosition)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

Application.SendKeys ("^c")
Application.SendKeys ("^v")
SetCursorPos 130, 160 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.SendKeys ("{NUMLOCK}")


Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event MOUSEEVENTF_MOVE, 0, 28, 0, 0

 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)





''3
SetCursorPos 130, 60 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.Wait (Now + TimeValue("00:00:01"))

SetCursorPos 1162, 320 'x and y position
 Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
SetCursorPos 1352, 355 'x and y position
 Call GetCursorPos(CurrentPosition)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

Application.SendKeys ("^c")
Application.SendKeys ("^v")
SetCursorPos 130, 160 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.SendKeys ("{NUMLOCK}")


Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event MOUSEEVENTF_MOVE, 0, 56, 0, 0

 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
 
''4
SetCursorPos 130, 60 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.Wait (Now + TimeValue("00:00:01"))

SetCursorPos 1345, 320 'x and y position
 Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
SetCursorPos 1518, 355 'x and y position
 Call GetCursorPos(CurrentPosition)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

Application.SendKeys ("^c")
Application.SendKeys ("^v")
SetCursorPos 130, 160 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.SendKeys ("{NUMLOCK}")


Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event MOUSEEVENTF_MOVE, 0, 84, 0, 0

 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
 
  SetCursorPos 800, 800 'x and y position
 Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
 
 'resize
 SetCursorPos 135, 30 'x and y position

 Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

 SetCursorPos 60, 80 'x and y position
 Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

 SetCursorPos 967, 667 'x and y position
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
mouse_event MOUSEEVENTF_MOVE, -868, -455, 0, 0
 Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

Application.Wait (Now + TimeValue("00:00:01"))
'Control S to Save
Application.SendKeys ("^s")
'Press Enter to Save File
Application.Wait (Now + TimeValue("00:00:01"))
Application.SendKeys ("{ENTER}")
Application.SendKeys ("{NUMLOCK}")
Application.SendKeys ("{ENTER}")


  
vPID = Shell("C:\Program Files (x86)\Google\Chrome\Application\Chrome.exe -URL https://twitter.com/compose/tweet", vbNormalFocus)
  Application.Wait (Now + TimeValue("00:00:03"))
 SetCursorPos 739, 450 'x and y position

Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    Application.Wait (Now + TimeValue("00:00:01"))
SetCursorPos 198, 147 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    Application.Wait (Now + TimeValue("00:00:01"))
Application.SendKeys ("{ENTER}")
Application.SendKeys ("{NUMLOCk}")
SetCursorPos 1200, 658 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    Application.Wait (Now + TimeValue("00:00:01"))
SetCursorPos 1200, 658 'x and y position
Call GetCursorPos(CurrentPosition)
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    Application.Wait (Now + TimeValue("00:00:01"))
    SetCursorPos 1905, 15 'x and y position
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    Application.Wait (Now + TimeValue("00:00:01"))
    SetCursorPos 1905, 15 'x and y position
    Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
    Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
    
    
    
    Application.Wait (Now + TimeValue("00:01:00"))
    
    'new end
       
       
goku = goku + 1
Loop
    
    
End Sub

The below is a GIF recording XY Coordinates live based on where the mouse is located for a series of XY coordinates. Essentially you can plan out a program for repetitive actions live. Refresh the page and scroll down if GIF already loaded. Record a series of XY coordinates. After 1 minute of no movement, then the program will run and click at each indicated XY coordinate recorded in columns H and I. Column H is X coordinate; Column I is Y coordinate. Each XY Coordinate is recorded by a 7 second timer which makes Excel wait 7 seconds. After the 7 second time, when you move your mouse cursor, it records that location on your screen as an XY coordinate.

Multiple XY Coordinates. It plays back all XY coordinates of mouse after 1 minute of no movement. Unlimited XY coordinates. It tracks them in columns H (X coordinates) and column I (Y coordinates). You can customize the 7 second delay in Excel for how long you want it to wait before recording when you move the mouse. Download

Private Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Private Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20 ' middle button down
Private Const MOUSEEVENTF_MIDDLEUP = &H40 ' middle button up
Private Const MOUSEEVENTF_RIGHTDOWN = &H8 ' right button down
Private Const MOUSEEVENTF_RIGHTUP = &H10 ' right button up
Private Const MOUSEEVENTF_MOVE = &H1 '  mouse move



Public Type POINTAPI
    X As Long
    Y As Long
End Type

Public Declare PtrSafe Function SetCursorPos Lib "User32.dll" (ByVal X As Integer, ByVal Y As Integer) As Long
Public Declare PtrSafe Function GetCursorPos Lib "User32.dll" (ByRef lpPoint As POINTAPI) As Long
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 Long)





Sub MouseMove()
Dim googlepath As String
googlepath = "C:\Program Files\Google\Chrome\Application\chrome.exe"
Dim wshell As Object
Dim vPID As Variant
Set wshell = CreateObject("Wscript.shell")
Set vPID = wshell.exec(googlepath)

' vPID = Shell("C:\Program Files\Google\Chrome\Application\chrome.exe -URL http://google.com", vbNormalFocus)

Dim lngCurPos As POINTAPI
Dim CurrentPosition As POINTAPI



Application.Wait (Now + TimeValue("00:00:07"))
Dim startTime As Double
Dim SecondsElapsed As Double
Dim MinutesElapsed As String
Dim stepper As Double
stepper = 1

startTime = Timer
Starttime1 = Timer
GetCursorPos lngCurPos
x2 = lngCurPos.X
y2 = lngCurPos.Y

Worksheets("Sheet1").Range("B1:B6").Value = ""
Worksheets("Sheet1").Range("A1").Value = "Cursor Position"
Worksheets("Sheet1").Range("A2").Value = "Time Elapsed"
Worksheets("Sheet1").Range("A3").Value = "Seconds Elapsed"
Worksheets("Sheet1").Range("A4").Value = "Time Remaining"
Worksheets("Sheet1").Range("A5").Value = "Times Activated"
Worksheets("Sheet1").Range("A6").Value = "Total Run Time"
Worksheets("Sheet1").Range("A7").Value = "Time to Activate"
Worksheets("Sheet1").Range("B4").Interior.ColorIndex = xlNone
Worksheets("Sheet1").Range("B7").Interior.ColorIndex = 6
Worksheets("Sheet1").Range("A1:B7").Borders.LineStyle = xlContinuous
Worksheets("Sheet1").Columns("A").ColumnWidth = 21
Worksheets("Sheet1").Columns("B").ColumnWidth = 15
Worksheets("Sheet1").Columns("B").HorizontalAlignment = xlCenter
If Worksheets("sheet1").Range("B7").Value = "" Then
    Worksheets("Sheet1").Range("B7").Value = "12:01:00 AM"
End If
Worksheets("Sheet1").Range("B7").NumberFormat = "hh:mm:ss"

SecondsToActivate = Worksheets("sheet1").Range("B7").Value
SecondsToActivate = Hour(SecondsToActivate) * 3600 + Minute(SecondsToActivate) * 60 + Second(SecondsToActivate)

counter = 0

Do

DoEvents

GetCursorPos lngCurPos
x1 = lngCurPos.X
y1 = lngCurPos.Y

If x1 <> x2 Or y1 <> y2 Then
    startTime = Timer
    Worksheets("sheet1").Range("B4").Interior.ColorIndex = xlNone
End If

SecondsElapsed = Round(Timer - startTime, 2)
MinutesElapsed = Format(((Timer - startTime) - 0.5) / 86400, "hh:mm:ss")

Worksheets("Sheet1").Range("B1").Value = "X: " & lngCurPos.X & " Y: " & lngCurPos.Y
Worksheets("Sheet1").Range("B2").Value = MinutesElapsed
Worksheets("Sheet1").Range("B3").Value = SecondsElapsed
Worksheets("Sheet1").Range("B4").Value = Format(((SecondsToActivate - SecondsElapsed) + 0.5) / 86400, "hh:mm:ss")
Worksheets("Sheet1").Range("B5").Value = counter
Worksheets("Sheet1").Range("B6").Value = Format(((Timer - Starttime1) - 0.5) / 86400, "hh:mm:ss")

If SecondsElapsed = 0 Then
Range("H" & stepper).Value = x1
Range("I" & stepper).Value = y1
stepper = stepper + 1
AppActivate Application.Caption
DoEvents
answer = MsgBox("Confirm this mouse position?", vbYesNo)
If answer = 7 Then
stepper = stepper - 1
Range("H" & stepper).Value = ""
Range("I" & stepper).Value = ""
End If

Application.Wait (Now + TimeValue("00:00:07"))

End If

If SecondsElapsed < SecondsToActivate * 0.7 Then
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.7 And SecondsElapsed < SecondsToActivate * 0.8 Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 6
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.8 And SecondsElapsed < SecondsToActivate * 0.9 Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 46
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(0, 0, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.9 And SecondsElapsed < SecondsToActivate * 0.95 Then
    Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3
    Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255)
ElseIf SecondsElapsed >= SecondsToActivate * 0.95 Then
    If SecondsElapsed Mod 2 <> 0 Then
        Worksheets("Sheet1").Range("B4").Interior.ColorIndex = 3
        Worksheets("Sheet1").Range("B4").Font.Color = RGB(255, 255, 255)
    End If
End If

If SecondsElapsed >= SecondsToActivate Then
'Variation 1:
vPID.Terminate
Set vPID = Nothing
Range("Ae3").Select
Selection.Copy
 Set DataObj = New MSForms.DataObject
 DataObj.GetFromClipboard

strpaste = DataObj.GetText(1)
Range("A1").Select

Set vPID = wshell.exec(googlepath)
Application.Wait (Now + TimeValue("00:00:02"))

Dim dracula As Double
dracula = 1
Dim numberholder As Double
Dim numberholder2 As Double
Dim holder As String

Do Until dracula > stepper
numberholder = Range("H" & dracula).Value
numberholder2 = Range("i" & dracula).Value
SetCursorPos 0, 0
SetCursorPos numberholder, numberholder2 'x and y position
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)

Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)
Application.Wait (Now + TimeValue("00:00:01"))
If dracula = 1 Then
Application.SendKeys (strpaste), True
Application.SendKeys ("{ENTER}")
End If
Application.Wait (Now + TimeValue("00:00:07"))
dracula = dracula + 1
If dracula > stepper Then
GoTo Line10:
End If

Loop
End If
GetCursorPos lngCurPos
x2 = lngCurPos.X
y2 = lngCurPos.Y

Loop
 

    
Line10:






End Sub

Category: VBA · Tags: excel, screen, XY coordinates

Comments are closed.

XY Coordinate Excel VBA

Search

Excel VBA Filter