When slide 5 is displayed change slide transition properties on slide 1 - vba

I have a presentation that slide 1 .AdvanceOnClick = msoTrue. This is so after the slide show starts, it waits for mouse click before advancing (want slide 1 to display and wait for mouse click).
After the initial mouse click to start advancing, for example on slide 5, I want to change the .AdvanceOnClick to msoFalse on Slide 1 so the second and subsequent loops auto progress without user intervention. Basically, I want to change the Slide 1 transition properties when the presentation advances to, for example, slide 5.
I have tried the following code, which works fine, but I can't run this code from a different slide;
With ActivePresentation.Slides(1).SlideShowTransition
.AdvanceOnClick = msoTrue
.AdvanceOnTime = msoTrue
.AdvanceTime = 5
End With

Set the presentation to loop without the pause after slide 1.
Create a separate presentation consisting of only slide 1.
Hyperlink that to slide 2 of the looping presentation.
Now slide 1 will display until you click the hyperlink. Once you click, the presentation will loop without stopping. No VBA required.

If you need only one ppt file for some reason then you'll have to use VBA, I believe. This code works just fine only if you use something (a shape) in slide 5 and assign a Mouse Click Action to it to link to slide 1. It doesn't work if you go back to slide 1 using the keyboard arrows or the mouse wheel.
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
If SSW.View.CurrentShowPosition = 5 Then
With ActivePresentation.Slides(1).SlideShowTransition
.AdvanceOnClick = msoTrue
.AdvanceOnTime = msoTrue
.AdvanceTime = 5
End With
End If
End Sub

Related

VBA Powerpoint Slide Transition to ignore animation time

Have a large slide show with lots of images, which I would like to have animating slowly.
But want a consistent transition time.
Unfortunately cannot find a way to get Powerpoint Transition time to be prioritized over slide animation time. Current code I'm using below to try to set transition times.
Sub slideAdvance()
With ActivePresentation.Slides.Range.SlideShowTransition
'make sure the next slide will be shown automatically.
.AdvanceOnTime = msoTrue
'Set "advance to next slide" time (in seconds).
.AdvanceTime = 5
End With
ActivePresentation.SlideShowSettings.AdvanceMode = ppSlideShowUseSlideTimings
End Sub

How to end a Powerpoint slideshow while staying on the current/active slide?

I'm looking for the opposite of the "Alt+F5" shortcut (Start a presentation from the current slide) as I have a very large presentation with many slides and want to be able to edit them quickly.
Currently, the "end show" action button I've set-upped (or the "ESC" shortcut) brings me back to my first slide.
I've managed to assign the following macro to a "stop" button, but this asks me to have as many lines as there are slides.
Sub ExitSlide3()
Application.SlideShowWindows(1).View.Exit
With Application.ActiveWindow
.ViewType = ppViewSlide
.View.GotoSlide 3
End With
End Sub
Using Insert>Action>Run macro, assign this to a shape, then copy the shape to each slide. The shape can be the same color as the background if you want it to be unobstrusive:
Sub ExitSlide()
ActivePresentation.SlideShowWindow.View.Exit
End Sub

PowerPoint VBA Macro Mouse Over and Mouse Out

I want to apply trigger animation when mouse over
I found very helpful tutorial so I can make the animation happen when mouse Over the button, but it allow the animation to happen only when the mouse come over the button again
What I need is to the required animation happen as below:
- when mouse over the button, the image appears
- when mouse out the button, the image disappears
(with no need to mouse re-over again the shape button)
Can someone help me achieve that.
here is the VBA code which in the tutorial,
Sub anim(oshp As Shape)
Dim osld As Slide
Set osld = oshp.Parent
'Note alter the name here to match the trigger shape
If osld.Shapes("Rectangle 7").ZOrderPosition = 1 Then
SendKeys ("{TAB}")
SendKeys ("{ENTER}")
Else
osld.Shapes("Rectangle 7").ZOrder (msoSendToBack)
End If
End Sub

How do I tell where the insertion point is in the Slides pane?

In PowerPoint, in "normal" view, the window is split into two panes, with a pane showing slide thumbnails on the left, and a pane showing the current slide on the right. You can select more than one slide in the left-hand panel, which is useful if you want to copy, move or delete slides.
To tell which slide(s) are currently selected in the left-hand panel, you can use ActiveWindow.Selection.SlideRange. However, if you click between slides in the left-hand (thumbnail) panel, you end up with an insertion point, and:
ActiveWindow.Selection.Type is zero (ppSelectionNone).
ActiveWindow.Selection.SlideRange gives an error.
I have a question in two halves:
How can I detect this situation? (Presumably there are other cases where the selection type is "none").
How can I tell where the insertion point is, so that I can insert new slides at that point?
Either VBA or VSTO code would be fine :-)
Answer to the first question:
' The mouse cursor can be placed between slide thumbnails in the following views:
' - Normal View / Thumbnail Pane
' - Slide Sorter View
' - Slide Master View / Thumbnail Pane
' Returns true if the cursor is in the slide gap in these cases.
Function IsSlideGap() As Boolean
On Error Resume Next
With ActiveWindow
Select Case .View.Type
Case ppViewNormal, ppViewSlideMaster
' If the thumbnail pane (ViewType 11 or 12 ) is active but
' nothing is selected, we must be in the slide gap
If .Panes(1).Active And .Selection.Type = ppSelectionNone Then IsSlideGap = True
Case ppViewSlideSorter
If .Selection.Type = ppSelectionNone Then IsSlideGap = True
End Select
End With
End Function
Answer to second question:
' Note: used by slide/gap context menus only so assumes
' either thumbnail pane or sorter view active
Function GetSlideCursorIndex() As Long
Dim lSlides As Long ' Track the number of slides in order
' to check if the temporary slide was deleted.
Dim oSld As Slide
lSlides = ActivePresentation.Slides.Count
' Insert a temporary new slide
CommandBars.ExecuteMso "SlideNew"
DoEvents
Set oSld = ActiveWindow.View.Slide
With oSld
GetSlideCursorIndex = .SlideIndex
.Delete
End With
If ActivePresentation.Slides.Count <> lSlides Then Debug.Print "Something went wrong!"
End Function
I just found this: http://skp.mvps.org/pptxp020.htm
Summary: switch to ppViewSlide view and then back again, and PowerPoint will select the slide before the insertion point (or the first slide, if the IP is at the start).
I'd still be interested in a better way that avoids the screen flicker inherent in this approach (and ideally does not change the selection).

Erase PowerPoint pen drawing and annotation

I want to programmatically erase user's pen drawing and annotation over slides in PowerPoint 2003/2007/2010 as an alternative to sending "E" keystroke.
I have found that SlideShowView.EraseDrawing only erases lines made by SlideShowView.DrawLine.
Sample code:
PowerPoint.Application.ActivePresentation.SlideShowSettings.Run.View.EraseDrawing
Thanks for your answers! rjobidon
Are you looking to delete the pen drawing after they've stopped the slide show and chosen to retain the drawing? In that case, invoke the EraseInkOnSlide function below on any slide you want to erase drawings from.
Sub TestMe()
EraseInkOnSlide ActivePresentation.Slides(1)
End Sub
Sub EraseInkOnSlide(oSl As Slide)
' Erases any INK shapes drawn by the user and
' retained when the user quits the slide show
Dim oSh As Shape
Dim x As Long
With oSl.Shapes
For x = .Count To 1 Step -1
If .Item(x).Type = 23 Then
.Item(x).Delete
End If
Next
End With
End Sub
I suspect you'd hve to drop out of slide show mode momentarily then return to the current slide in slideshwo mode in order to get this to work in slide show mode; PPT apparently doesn't consider the ink shapes part of the slide's shapes collection until the user has ended the show and elected to keep the shapes. Weird.
This gives the user the option of keeping or deleting the ink, then goes back to the original slide in slide show view. STILL not what you're after, really, but it's as close as I've been able to get so far:
Private Sub CommandButton1_Click()
Dim x As Long
x = SlideShowWindows(1).View.Slide.SlideIndex
With SlideShowWindows(1)
.View.Exit
End With
With ActivePresentation
.SlideShowSettings.Run
End With
SlideShowWindows(1).View.GotoSlide (x)
End Sub