PC Review


Reply
Thread Tools Rate Thread

Code to simulate mouse click not working - code sample attached

 
 
John Michl
Guest
Posts: n/a
 
      18th Oct 2005
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

 
Reply With Quote
 
 
 
 
Steve Rindsberg
Guest
Posts: n/a
 
      18th Oct 2005

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.


In article <(E-Mail Removed)>, John Michl
wrote:
> 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, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================


 
Reply With Quote
 
John Michl
Guest
Posts: n/a
 
      18th Oct 2005
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

 
Reply With Quote
 
Steve Rindsberg
Guest
Posts: n/a
 
      19th Oct 2005
In article <(E-Mail Removed)>, John Michl
wrote:
> 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????



>
> 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, PPT MVP
PPT FAQ: www.pptfaq.com
PPTools: www.pptools.com
================================================


 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Code not working when attached to form TimH Microsoft Access Getting Started 4 27th Mar 2008 08:05 PM
Why Isn't My Mouse Click Code Working =?Utf-8?B?SmVycnk=?= Microsoft Dot NET 3 21st May 2007 12:05 AM
Simulate Mouse Click Abhishek Microsoft C# .NET 4 24th Jul 2006 05:07 PM
Changing DataViewManager.RowFilter has no effect - Sample Northwind Code Attached - Northwind.zip (0/1) Jay Pondy Microsoft Dot NET Framework Forms 0 12th Feb 2005 12:24 PM
Weird MDI problem - sample code attached - WindowsApplication1.zip (0/1) Andrew K Microsoft VB .NET 1 11th Feb 2004 11:59 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 01:24 AM.