PowerPoint (or Excel) VBA Capture Coordinates of Mouse Click

Question

Some Background:

The quick background is that I am in the research stages of building an add-in for PowerPoint. My end goal is to develop a CAD Dim

Answer 1

You can accomplish what you are looking to do by doing the following (the bottom part may be the most helpful to you): First, Declare the following:

Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
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 Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10

and the following code snippets will allow you do either click, double click, or right click:

Private Sub SingleClick()
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Private Sub DoubleClick()
  'Double click as a quick series of two clicks
  SetCursorPos 100, 100 'x and y position
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Private Sub RightClick()
  Right Click
  SetCursorPos 200, 200 'x and y position
  mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
  mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

All you need to do is change the cursor position to the coordinates on the screen. To do this, I made a new macro with the following code and assigned it to the "Ctrl+Y" button. This will tell you the coordinates of your current mouse location.

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

Sub CurosrXY_Pixels()

    Dim lngStatus As Long
    Dim typWhere As POINTAPI

    lngStatus = GetCursorPos(typWhere)
    MsgBox "x: " & typWhere.x & Chr(13) & "y: " & typWhere.y, vbInformation, "Pixels"

End Sub