|
This routine is a simplistic approach
to extracting the current selection of slides as a new presentation
while still retaining all the slide formatting. The idea is simple.
Save a copy of the presentation and then delete the slides which are
not in the selection from the copy and then open this copy for viewing.
'
--------------------------------------------------------------------------------
' Copyright ©1999-2011, Shyam Pillai, All Rights Reserved. ' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this '
code as well as reproducing the code in text or html format. ' --------------------------------------------------------------------------------
Option Explicit Public Declare Function
GetTempPath Lib "kernel32" Alias _ "GetTempPathA" (ByVal
nBufferLength As Long, ByVal lpBuffer As String) As Long
Sub
ExtractSelection() Dim oPres As Presentation Dim oSlide As
Slide Dim sIDs As String Dim sTempFile As String Dim I As
Integer On Error Resume Next
' Create a string containing slide IDs of selection ' It output
string will look like this ":256:276:290:" sIDs = ":"
For Each oSlide In ActiveWindow.Selection.SlideRange
sIDs = sIDs & CStr(oSlide.SlideID) & ":" Next oSlide
' Create path to store dummy file
sTempFile = GetUserTempFolder & "~temp.ppt"
' save a copy of the original file
Call ActivePresentation.SaveCopyAs(sTempFile)
' Open the copy Set oPres
= Application.Presentations.Open(sTempFile, , False)
' Search for IDs which do not
appear in the ID string and delete those slide. ' e.g. since it
is a copy, it will also have the same slide IDs ' Search if
":256:" exists in the earlier list of IDs, if it does ' retain
the slide else delete it. With oPres
For I = .Slides.Count To 1 Step -1
If InStr(1, sIDs, ":" & CStr(.Slides(I).SlideID) & ":") = 0 Then
.Slides(I).Delete End
If Next I End With oPres.Save
oPres.Close Call Application.Presentations.Open(sTempFile, ,
True, True) ' Delete the temp
file Kill sTempFile End Sub Function
GetUserTempFolder() As String '
Function to retrieve the temp folder On Error Resume Next
Dim sTemp As String sTemp = String(100, Chr$(0)) Call
GetTempPath(100, sTemp) sTemp = Left(sTemp, InStr(sTemp, Chr$(0))
- 1) GetUserTempFolder = sTemp Exit Function
Error_GetUserTempFolder: GetUserTempFolder = "" End Function
|
|
We shall see
how to create an interactive animation sequence. We shall create two
shapes. Shape A will be assigned a circular motion path animation which
will occur when the user clicks on Shape B.
This works for
PowerPoint 2002 or later.
' --------------------------------------------------------------------------------
' Copyright ©1999-2011, Shyam Pillai, All Rights Reserved. ' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this '
code as well as reproducing the code in text or html format. ' --------------------------------------------------------------------------------
Sub CreateAnimationWithTrigger() Dim oEffect
As Effect Dim oShpA As Shape Dim oShpB As Shape With
ActivePresentation.Slides(1)
'Create two autoshapes on the slide.
Set oShpA
= .Shapes.AddShape(msoShapeRectangle, 100, 100, 50, 50)
Set oShpB
= .Shapes.AddShape(msoShapeRectangle, 200, 100, 50, 50)
' Assign an
interactive animation to shape A Set
oEffect = .TimeLine.InteractiveSequences.Add _
.AddEffect(Shape:=oShpA, effectId:=msoAnimEffectPathCircle, _
trigger:=msoAnimTriggerOnShapeClick) End With
' Define the triggering shape. If
you omit this line then the animation will be ' triggered by
clicking on the shape A itself.
oEffect.Timing.TriggerShape = oShpB End Sub

|