Code to simulate mouse click not working - code sample attached

[John Michl]

I've also posted this in the VBA forum but that is getting only one new
post per day with very little response. Hoping someone can help me out
here. If there is a better place for me to hunt for help, please point
me in that direction.

This is not my area of expertise so I'd appreciate some help. I found
this code in the newsgroups to simulate a mouse click on a certain part
of the screen in PowerPoint. (I'm using PPT 2003)

I added the MsgBoxes "About to send Click" and "Sent Click" to help me
trouble shoot. I'm starting the Sub "CmdClickDesktop_Click() while in
presentation mode by clicking on a shape with that macro attached.
When I click to trigger it, nothing happens at all. Not even the very
first MsgBox. Any ideas on why?

Thanks

- John

==============================================================


Sub CmdClickDesktop_Click()
Dim lX As Long
Dim lY As Long
lX = 1
lY = 1

MsgBox "About to send click"
'Send the mouse Left Button click
SendMouseLeftClick lX, lY
MsgBox "Sent Click"
End Sub

Private Type POINTAPI
X As Long
Y As Long
End Type

Declare Function SetCursorPos Lib "user32" _
(ByVal X As Long, ByVal Y As Long) As Long

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)


Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_ABSOLUTE = &H8000


Sub SendMouseLeftClick(ByVal lX As Long, ByVal lY As Long)
'NOTE: lX and lY are assumed to be Screen coordinates
' relative to the uper left corner (0,0).
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Set cursor position
SetCursorPos lX, lY


'Convert Pixel coordinates to Normalized ones
ScreenToNormalizedCord lX, lY


'Send the mouse event
lFlags = MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_ABSOLUTE
mouse_event lFlags, lX, lY, 0, 0


lFlags = MOUSEEVENTF_LEFTUP Or MOUSEEVENTF_ABSOLUTE
mouse_event lFlags, lX, lY, 0, 0
End Sub

Sub ScreenToNormalizedCord(lX As Long, lY As Long)
'Converts Screen coordinates in Pixels
'to Absolute normalized Screen coordinates.
'''''''''''''''''''''''''''''''''''''''''''''
Dim lScreenWidth As Long
Dim lScreenHeight As Long


'Find Screen size in pixels
lScreenWidth = Screen.Width \ Screen.TwipsPerPixelX
lScreenHeight = Screen.Height \ Screen.TwipsPerPixelY


'Convert Pixel cordinates to absolute normalized ones
lX = (lX / lScreenWidth) * 65535
lY = (lY / lScreenHeight) * 65535
End Sub

 

[Steve Rindsberg]

It always helps if you choose Debug, Compile before trying to run a project.
It's also a good idea to add Option Explicit to the top of each module.
This forces you to be more careful about declaring variables.

First, Sub CmdClickDesktop_Click should appear after all the declarations.

Next, lFlags isn't dimmed in SendMouseLeftClick

But the biggie is the Screen.xxx stuff.
There's no Screen object in PPT vba, so this won't fly, I'm afraid.

 

[John Michl]

Thanks, Steve. That is helpful. Now the clincher...

Is there a way to simulate a mouse click? I'm trying to kick of a
triggered animation after accepting user input from the keyboard.

For instance, in Presentation mode.
1) Presenter click a shape to start macro
2) Audience gives a number (1 through 5)
3) Presenter enters the number in an Input box generated by the macro
4) If input = 1, triggered animation sequence for shape1 starts
If input = 2, triggered animation sequence for shape2 starts,
etc...

- John

 

[Steve Rindsberg]

Thanks, Steve. That is helpful. Now the clincher...

Animation question! I *knew* this was coming and still I didn't run for the
hills. ;-)

See, I'm not the guy to ask about animation.
As near clueless as they come, in fact.

Oh Shyam? Chirag????