Improve company productivity with a Business Account.Sign Up
' PowerPoint VBA Macro
' Author : Jamie Garroch
' Date : 19DEC2014
' Copyright (c) 2014 GMARK Ltd. http://youpresent.biz
' Source code is provide under Creative Commons Attribution License
' This means you must give credit for our original creation in the following form:
' "Includes code created by GMARK Ltd. (YOUpresent.biz)"
' Commons Deed @ http://creativecommons.org/licenses/by/3.0/
' License Legal @ http://creativecommons.org/licenses/by/3.0/legalcode
' Purpose : make the shape-implemented timer trigger automatically
' Dependencies : A shape-stack Countdown Timer from A6 Training & Consultancy Ltd.
' Usage : 1. Select and copy all the shapes in a timer shape stack
' 2. Paste the shape stack to a slide without any other animation*
' 3. With the shape stack selected on the target slide, press
' Alt-F8 and run the MakeTimerAutomatic macro
' Tested with the 60 second stack on slide 4 only
' * The code could be modified to check the relevant sequence as required
' How it works:
' - The user copies and pastes the shape stack to a target slide
' - The macro looks at each animation effect in the interactive (trigger) sequence
' - Each effect is copied and recreated in the main timeline sequence
' - All effects in the interactive sequence are deleted
' Do some basic selection checks
If Not ActiveWindow.Selection.Type = ppSelectionShapes Then GoTo selectionError
If Not ActiveWindow.Selection.ShapeRange.Count > 0 Then GoTo selectionError
Dim oShp As Shape
Dim oSld As Slide
Dim effectShape As Shape, effectType As MsoAnimEffect, effectDuration As Single, effectDelay As Single, effectExit As Boolean
Dim effectID As Integer
Dim oEffect As Effect
Dim iEffects As Integer
' Get a reference to the slide on which the selection was made
Set oSld = ActiveWindow.Selection.ShapeRange.Parent
' Loop through each animation effect in the interactive trigger sequence, copying its parameters before recreating the effect in the main sequence
iEffects = oSld.TimeLine.InteractiveSequences(1).Count
For effectID = 1 To .Count
' Copy the relevant animation effect properties from the interactive trigger sequence
effectType = .Item(effectID).effectType
effectDuration = .Item(effectID).Timing.Duration
effectDelay = .Item(effectID).Timing.TriggerDelayTime
effectExit = .Item(effectID).Exit
Set effectShape = .Item(effectID).Shape
' Add a new effect to the main (non-interactive) sequence
Set oEffect = oSld.TimeLine.MainSequence.AddEffect(effectShape, effectType, , msoAnimTriggerAfterPrevious)
oEffect.Exit = effectExit
oEffect.Timing.TriggerDelayTime = effectDelay
' Delete the effects from the interactive trigger sequence (need to count backwards in the collection)
For effectID = oSld.TimeLine.InteractiveSequences(1).Count To 1 Step -1
' Provide the user with feedback
MsgBox iEffects & " animation effects have been converted from the interactive trigger sequence to the main timeline sequence.", _
vbInformation + vbOKOnly, "Macro by youpresent.biz"
MsgBox "Please select a group of shapes representing a timer.", vbCritical + vbOKOnly, "Selection Error"
Open in new window
Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Please enter a first name
Please enter a last name
Must be at least 4 characters long.
Join and Comment
Be seen. Boost your question’s priority for more expert views and faster solutions