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

            .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

 

 

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

                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
 

 


 


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