How to position mouse pointer on-click

Question

Hi

Is it possible to position the mouse pointer over specific object after clicking on another object ?

In other words, is it possible to move the mouse pointer to an object in slide ?

Thank you !!!

Answer 1

gonen,

I put together some example slides in the this file: http://sdrv.ms/LvF5gH to demonstrate the different ways of doing what you want.  Note you will need to download the file from SkyDrive, click the link, then do File > Download a copy.  Enable macros when you open it. 

The first slide uses normal Custom Animation (without triggers).  Each time the mouse is clicked (anywhere on the slide), the next textbox in the sequence appears.

The second slide uses triggered Custom Animation.  You have to click on an arrow to make that arrow’s text box appear.  To do this, select the shape, then in the Custom Animation pane, after doing Add Effect > Entrance > Appear, click the down arrow to the right of the new animation effect and choose Effect Options.  Go to the Timing tab, click the Triggers button and select the shape you want to trigger this animation.

The third slide is exactly the same as slide 2 (text boxes are shown via triggered animation), but each arrow shape also has an Action assigned, so that the mouse is moved to the next arrow shape in the sequence, but the user can still show the text boxes in any order (the macros Shape1Click to Shape6Click are used).

The fourth slide has the 6 textboxes already made invisible (using the Selection pane).  The arrow shapes have the macros Shape1aClick to Shape6aClick assigned.  Each of these macros uses VBA to make the relevant text box visible, and then move the mouse pointer as before.  You could use some other code to make the boxes invisible to start with, but clearly using Custom Animation is much easier.

Note that the first code I gave you was not very good.  I fixed it so it now works with any size slide.  New code is below.  Also I changed it so the main procedure accepts the name of the shape to be jumped to as a string argument.   As you can see from the smaller procedures at the bottom, it’s now easy to have the mouse jump to several different shapes depending on which shape is clicked (each shape has to have a macro Action assigned).

Hope this helps.

Cheers

Rich

Here's the VBA code:

Option Explicit

*'Declare function to get screen size in pixels:*Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CXSCREEN = 0  'Screen width

Private Const SM_CYSCREEN = 1  'Screen heigh

*'Declare function to move the mouse pointer:*Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long

Private Sub MoveMouseToShape(strShpName As String)

' Moves the mouse pointer to the centre of the designated shape.'

    Dim dbScaleFac As Double 'Factor by which slide is scaled in both directions to fill the screen in one direction

    Dim dbScrX  As Double   'Screen size in pixels    Dim dbScrY  As Double

    Dim dbSldShwX As Double 'Screen size in slideshow in points    Dim dbSldShwY As Double

    Dim dbSldX  As Double   'Slide size in points    Dim dbSldY  As Double

    Dim dbSlideRatio As Double

    Dim dbSldShwRatio As Double

    Dim dbPntsPerPixX As Double

    Dim dbPntsPerPixY As Double

    Dim dbBlackWidth As Double  'Size of black space in slideshow in points

    Dim dbBlackHeight As Double

    Dim dbLeft As Double, dbTop As Double

    Dim sld As Slide

    Dim shp As Shape

    If Application.SlideShowWindows.Count = 0 Then Exit Sub

'Get the current slide and shape to move mouse to:    Set sld = ActivePresentation.SlideShowWindow.View.Slide

    Set shp = sld.Shapes(strShpName)

'Get slide dimensions in points:    dbSldX = ActivePresentation.PageSetup.SlideWidth

    dbSldY = ActivePresentation.PageSetup.SlideHeight

    dbSlideRatio = dbSldX / dbSldY

'Get screen dimensions (in slideshow) in points:    dbSldShwX = ActivePresentation.SlideShowWindow.Width

    dbSldShwY = ActivePresentation.SlideShowWindow.Height

    dbSldShwRatio = dbSldShwX / dbSldShwY

'Get Screen dimensions in pixels:    dbScrX = GetSystemMetrics(SM_CXSCREEN)

    dbScrY = GetSystemMetrics(SM_CYSCREEN)

    dbPntsPerPixX = dbSldShwX / dbScrX

    dbPntsPerPixY = dbSldShwY / dbScrY

'Calculate the size of black space at the screen     'sides or top & bottom in points:    If dbSlideRatio <= dbSldShwRatio Then

'There will be black at the sides (or zero):

        dbScaleFac = dbSldShwY / dbSldY

        dbBlackWidth = (dbSldShwX - (dbSldX * dbScaleFac)) / 2 'points

        dbBlackHeight = 0

    Else

'There will be black at the top and bottom:        dbScaleFac = dbSldShwX / dbSldX

        dbBlackWidth = 0

        dbBlackHeight = (dbSldShwY - (dbSldY * dbScaleFac)) / 2 'points

    End If

'Get screen coordinates of shape centre in pixels:    dbLeft = ((dbScaleFac * shp.Left) + (dbScaleFac * shp.Width / 2) + dbBlackWidth) / dbPntsPerPixX

    dbTop = ((dbScaleFac * shp.Top) + (dbScaleFac * shp.Height / 2) + dbBlackHeight) / dbPntsPerPixY

'Move the mouse to centre of designated shape:    SetCursorPos CLng(dbLeft), CLng(dbTop)

End Sub

 'EXAMPLES OF HOW TO CALL THE ABOVE PROCEDURE:

Sub Shape1Click()

    Call MoveMouseToShape("Right Arrow 2")

End Sub

Sub Shape2Click()

    Call MoveMouseToShape("Right Arrow 3")

End Sub

Sub Shape3Click()

    Call MoveMouseToShape("Right Arrow 4")

End Sub

Sub Shape4Click()

    Call MoveMouseToShape("Right Arrow 5")

End Sub

Sub Shape5Click()

    Call MoveMouseToShape("Right Arrow 6")

End Sub

Sub Shape6Click()

    Call MoveMouseToShape("Right Arrow 1")

End Sub

Sub Shape1aClick()

    ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 1").Visible = msoTrue

    Call MoveMouseToShape("Right Arrow 2")

End Sub

Sub Shape2aClick()

    ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 2").Visible = msoTrue

    Call MoveMouseToShape("Right Arrow 3")

End Sub

Sub Shape3aClick()

    ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 3").Visible = msoTrue

    Call MoveMouseToShape("Right Arrow 4")

End Sub

Sub Shape4aClick()

    ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 4").Visible = msoTrue

    Call MoveMouseToShape("Right Arrow 5")

End Sub

Sub Shape5aClick()

    ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 5").Visible = msoTrue

    Call MoveMouseToShape("Right Arrow 6")

End Sub

Sub Shape6aClick()

    ActivePresentation.SlideShowWindow.View.Slide.Shapes("TextBox 6").Visible = msoTrue

    Call MoveMouseToShape("Right Arrow 1")

End Sub

Answer 2

I think you missed me.

I have 6 arrows on a slide.

click on an arrow - pops up a shape with text to talk about.

the scenario is always:

click arrow 1 pops up object1 with text, talk.....

click arrow 2, pops up object2 with text, talk.....

click arrow 3, pops up object3 with text, talk.....

why should the presenter bother himself moving the mouse from arrow 1 to arrow 2, then to arrow 3 ?

I thought of:

click arrow 1 pops up object1 with text and move the mouse pointer to arrow 2, talk.....

click arrow 2, pops up object2 with text and move the mouse pointer to arrow 3, talk.....

click arrow 3, pops up object3 with text, talk.....

I hope I am clear now.

Thank you !!!

Answer 3

I don't think i missed you!

As Rich shows you (and I said) you can position the cursor with API calls BUT as soon as you move the real mouse the pointer will jump back to the first click. Is that not what you see?

The whole point of triggered animation is that they are INTERACTIVE (under the control of the presenter). If the sequence of clicks is always the same then there's no need to use triggers is there?

Answer 4

I got it !

thanks !

Answer 5

Hi John,

You said “...you can position the cursor with API calls BUT as soon as you move the real mouse the pointer will jump back to the first click.Is that not what you see?”

NO!, this is not what I see (otherwise I wouldn’t have posted that code).  It works perfectly for me.  Could there be an issue with your PC or windows version?  I’m running Office 2007 on a Windows 7 Dell laptop.

Please can you test this file: http://sdrv.ms/LvF5gH (slides 3 and 4) and verify you still see that issue?

Cheers

Rich