Link to home
Start Free TrialLog in
Avatar of adinas
adinas

asked on

Making the mouse move and click

I would like to cause the mouse to move and click. to do this using the keyboard i use the following code:

Dim ReturnValue, I
ReturnValue = Shell("C:\Program Files\Plus!\Microsoft Internet\IEXPLORE.EXE", 1)   ' Run Calculator.
'MsgBox ReturnValue
AppActivate ReturnValue    ' Activate
Timer1.Enabled = True
SendKeys "{F5}", True

this is to open explorer and hit the F5 key.

Is there an equivilent for the mouse?
Avatar of samopal
samopal

Hi!
Copy this text in Module and call functions you need


Option Explicit

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 Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
   
Public Const MOUSE_MICKEYS = 65535

Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
Public Const TWIPS_PER_INCH = 1440
Public Const POINTS_PER_INCH = 72


Public Enum enReportStyle
    rsPixels
    rsTwips
    rsInches
    rsPoints
End Enum
   
   
   
   
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MOVE = &H1


Public Type POINTAPI
    X As Long
    Y As Long
    End Type
       
Public Sub GetMousePos(GetX As Long, GetY As Long)
    Dim n As POINTAPI
    GetCursorPos n
    GetX = n.X
    GetY = n.Y
End Sub

Public Sub LeftClick()
    LeftDown
    LeftUp
End Sub

Public Sub LeftDown()
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Sub

Public Sub LeftUp()
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Public Sub MiddleClick()
    MiddleDown
    MiddleUp
End Sub

Public Sub MiddleDown()
    mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
End Sub

Public Sub MiddleUp()
    mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End Sub

Public Sub MoveMouse(xMove As Long, yMove As Long)
    mouse_event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End Sub

Public Sub RightClick()
    RightDown
    RightUp
End Sub

Public Sub RightDown()
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
End Sub

Public Sub RightUp()
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Public Sub SetMousePos(xPos As Long, yPos As Long)
    SetCursorPos xPos, yPos
End Sub

Public Sub GetScreenRes(ByRef X As Long, ByRef Y As Long, Optional ByVal ReportStyle As enReportStyle)


    X = GetSystemMetrics(SM_CXSCREEN)
    Y = GetSystemMetrics(SM_CYSCREEN)


    If Not IsMissing(ReportStyle) Then


        If ReportStyle <> rsPixels Then
            X = X * Screen.TwipsPerPixelX
            Y = Y * Screen.TwipsPerPixelY


            If ReportStyle = rsInches Or ReportStyle = rsPoints Then
                X = X \ TWIPS_PER_INCH
                Y = Y \ TWIPS_PER_INCH


                If ReportStyle = rsPoints Then
                    X = X * POINTS_PER_INCH
                    Y = Y * POINTS_PER_INCH
                End If


            End If


        End If


    End If


End Sub

' Converts pixel X coordinates to mickeys
Public Function PixelXToMickey(ByVal pixX As Long) As Long
    Dim X As Long
    Dim Y As Long
    Dim tX As Single
    Dim tpixX As Single
    Dim tMickeys As Single
    GetScreenRes X, Y
    tMickeys = MOUSE_MICKEYS
    tX = X
    tpixX = pixX
    PixelXToMickey = CLng((tMickeys / tX) * tpixX)
End Function

' Converts pixel Y coordinates to mickeys
Public Function PixelYToMickey(ByVal pixY As Long) As Long
    Dim X As Long
    Dim Y As Long
    Dim tY As Single
    Dim tpixY As Single
    Dim tMickeys As Single
    GetScreenRes X, Y
    tMickeys = MOUSE_MICKEYS
    tY = Y
    tpixY = pixY
    PixelYToMickey = CLng((tMickeys / tY) * tpixY)
End Function

ASKER CERTIFIED SOLUTION
Avatar of samopal
samopal

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of adinas

ASKER

Great! worked like a charm