vba macro powerpoint with selected shapes

Question

I have a simple macro that made shapes appear and disapear as you click on them, in loop.

To use the macro I have to paste my shapes in an empty slide.

I would like to improve the macro and could use it in a slide with other shapes, select the shapes and apply the macro to them but not to the rest of unselected shapes.

Any idea? Thanks

Here is the code

Sub Createanimation()

Set oSld = Application.ActiveWindow.View.Slide

Z = oSld.Shapes.Count

For i = 1 To Z

Set oEffect1 = oSld.TimeLine.InteractiveSequences.Add.AddEffect(Shape:=oSld.Shapes(i), effectId:=msoAnimEffectAppear, Trigger:=msoAnimTriggerOnShapeClick)
    If i = 1 Then
    oEffect1.Timing.TriggerShape = oSld.Shapes(Z)
    Else
    oEffect1.Timing.TriggerShape = oSld.Shapes(i - 1)
    End If
    oEffect1.Timing.TriggerType = msoAnimTriggerWithPrevious



Set oEffect2 = oSld.TimeLine.InteractiveSequences.Add.AddEffect(Shape:=oSld.Shapes(i), effectId:=msoAnimEffectAppear, Trigger:=msoAnimTriggerOnShapeClick)
    oEffect2.Exit = msoCTrue
    oEffect2.Timing.TriggerShape = oSld.Shapes(i)
    oEffect2.Timing.TriggerType = msoAnimTriggerWithPrevious

Next i

oSld.Shapes.Range.Align msoAlignMiddles, msoTrue
oSld.Shapes.Range.Align msoAlignCenters, msoTrue


End Sub

Dhirendra Kumar Dhirendra Kumar · Accepted Answer · 2019-11-05T08:20:14

Use following code to get all the selected shapes in active slide:

Dim Shp As Shape
For Each Shp In ActiveWindow.Selection.ShapeRange
'Put code for action on each shape here

Next

If you want to use counter:

Dim Shp As Shape, SelectedShapes as Shapes

Set SelectedShapes = ActiveWindow.Selection.ShapeRange
For i=1 to SelectedShapes.Count
Set Shp = SelectedShapes(i)
'Put code for action on each shape here

Next

vba macro powerpoint with selected shapes

2 Answers