VBA to find mouse click RRS feed

  • Question

  • Hi I need a Help for office Publisher. I Need to put the rectangle when i click on the publisher page. I want to insert the shape(rectangle) in the position where user click.

    1. Making a loop till pressing Escape. - Completed

    2. Find the x and y of the Mouse click - Completed

    3. Converting it to the left and top of the publisher. - Struggling

    4. Inserting the shape(Rectangle) - Completed

    Need help for step 3

    Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
    Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    Private Const VK_ESCAPE = &H1B

    Private Type POINTAPI
        x As Long
        y As Long
    End Type

    Sub MouseClicked()
    Dim l As Long
    Dim pt As POINTAPI

    MsgBox Application.ActiveWindow.hwnd


    If (GetAsyncKeyState(vbKeyLButton)) Then
    l = GetCursorPos(pt)
    MsgBox pt.x & ", " & pt.y

    ElseIf (GetAsyncKeyState(VK_ESCAPE)) Then
    GoTo BB
    End If

    Call GetCursorPos(pt)
    Call ScreenToClient(ActiveWindow.hwnd, pt)

    pt.x = pt.x * Screen.TwipsPerPixelX
    pt.y = pt.y * Screen.TwipsPerPixelY

    MsgBox "My Position:" & vbLf & pt.x & "," & pt.y

    GoTo AA
    End Sub

    Monday, June 24, 2013 6:35 AM

All replies

  • You can refer this refrence ,it will help you for your progreming


    Thanks & rEgards,

    Gaurav Badhani.

    Monday, June 24, 2013 11:12 AM
  • Could you please tell me how I could sort out this. I need it for publisher and not for corel draw,

    I need something that can convert click of mouse(X and Y position of the screen to the Window point) to left and top of the publisher page.

    Hope that makes sense.

    Thanks and regards

    Jithin Prakash

    Monday, June 24, 2013 12:41 PM
        Dim Pos As POINTAPI
        lngStatus = GetCursorPos(Pos)
        ActiveDocument.Pages(1).Shapes.AddShape Type:=msoShapeRectangle, Left:=Pos.x, Top:=Pos.y, Width:=100, Height:=100

    Somehow the code is getting edited in to HTML or simply not show so added a code block


    Nithin Gopala

    Tuesday, June 25, 2013 6:34 AM
  • Yea fine. The code is good.

    But the position of the cursor and position of the rectangle does not match.

    Pos.x is the position of cursor on screen but not on page. The Point of cursor on screen should be = the point of the cursor on the page.

    It creates the rectangle somewhere on the page. Also not detecting the zoom.

    Tuesday, June 25, 2013 11:23 AM
  • It is not possible to do in Publisher VBA.

    I have found a turn around and completed it.

    If any one struggling for the same feel free to contact me.

    Friday, April 24, 2015 10:40 AM
  • It  is possible with Win32 commands.  Do something like this

    Call AppActivate("Publisher")
    hndl = GetForegroundWindow()
    If hndl > 0 Then
        retval = GetWindowPlacement(hndl, wp)

    This gets you the placement of Publisher on the screen.  You get the mouse click location then do a little math and you have the mouse location relative to publisher.  I am not sure of the name for publisher.  I often set the placement of the program so it is easy to find the point.

    Friday, April 24, 2015 1:24 PM
  • The issue is that, there is a zoom option in publisher and we never can get the posistion of the mouse relative to the page, but relative to the window. So, i wont be able to insert a shape on publisher with mouseclick.
    Wednesday, December 9, 2015 8:03 AM
  • I don't have Publisher but there must be a way to set zoom to a specific value.  There is in Excel and Word.

    Wednesday, December 9, 2015 7:49 PM