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 don't think that's really feasible. You can move the pointer using SetCursorPosition API but it will move straight back to the real mouse position.

Answer 3

If you hit Alt+F11, the do Insert > Module, then paste in the code below the line below.

Next you need to have a shape named JumpToMe on your slide.  You can rename a shape via the Selection Pane: Home tab > Editing group > Select... > Selection Pane.  Either rename a shape, or edit the code as indicated.

Then, with the shape to be clicked selected, do Insert tab > Links group > Action, then select Run macro, and choose MoveMouseToShape from the dropdown.

This will only work in full screen slideshow mode (not if you have your slideshow displaying in a window), and is not configured to work with multiple monitors.

Hope that helps.

Cheers

Rich

______________________________________________________

[EDIT: THIS CODE IS INCORRECT!!!  DO NOT USE - USE THE CODE IN MY LATER POST]

Option Explicit

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

Private Const SM_CXSCREEN = 0  'Screen widthPrivate Const SM_CYSCREEN = 1  'Screen height

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

Sub MoveMouseToShape()

' Moves the mouse pointer to the centre of the designated shape.'    Dim dbScaleFac As Double

    Dim dbScrX  As Double   'Screen size in points

    Dim dbScrY  As Double

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

    Dim dbSldX  As Double   'Slide size in points

    Dim dbSldY  As Double

    Dim dbScreenRatio As Double

    Dim dbSlideRatio As Double

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

    Dim sld As Slide

    Dim shp As Shape

    Dim dbLeft As Double, dbTop As Double

    If Application.SlideShowWindows.Count = 0 Then Exit Sub

'Get the current slide:    Set sld = ActivePresentation.SlideShowWindow.View.Slide

    Set shp = sld.Shapes("JumpToMe") '### ADD NAME OF SHAPE TO JUMP TO HERE ###

'Get slideshow dimensions:    dbSldShwX = ActivePresentation.SlideShowWindow.Width

    dbSldShwY = ActivePresentation.SlideShowWindow.Height

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

    dbSldY = ActivePresentation.PageSetup.SlideHeight

    dbSlideRatio = dbSldX / dbSldY

'Get Screen dimensions and ratio in Points:    dbScrX = GetSystemMetrics(SM_CXSCREEN)

    dbScrY = GetSystemMetrics(SM_CYSCREEN)

    dbScreenRatio = dbScrX / dbScrY

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

'There will be black at the sides (or zero):        dbScaleFac = dbScrY / dbSldY

        dbBlackWidth = (dbScrX - dbSldShwX) / 2

        dbBlackHeight = 0

    Else

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

        dbBlackWidth = 0

        dbBlackHeight = (dbScrY - dbSldShwY) / 2

    End If

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

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

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

End Sub

PS. Be sure to save your presentation as .pptm macro enabled!

Answer 4

This is cool... 

I thought its a valid feature that should be included within PPT....

e.g

A slide with three button. I cannot think  of better interface for the presenter than to place the mouse on the second button right after the first button is clicked, then on the third button on-click of the second button...

Am I wrong ?

Thanks anyway !!!

Answer 5

To be honnest, I can't think of a scenario when I would ever want to do this.

Are you trying to use the mouse pointer to "emphasize" a text box?  If so, a better way might be to use Custom Animation to apply an Emphasis to shapes.

Might be slightly different in 2010, but in 2007, go to the Animation tab and click Custom Animation.

Select the shape.

On the right, click Add Effect and choose Emphasis > More Effects, and then choose either Change Fill Color or Change Line Color > OK.

Set the fill/line color in the Custom Animation pane, then repeat the whole process for the other shapes.

Hope that helps.

Cheers

Rich