OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Extract slide selection as presentation

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.

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
        End If
    Next I
End With
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
GetUserTempFolder = ""
End Function


How to assign an interactive animation 


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.

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, _
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



Copyright 1999-2018 (c) Shyam Pillai. All rights reserved.