vba 帶有選定形狀的宏 powerpoint

Question

我有一個簡單的宏，當你點擊它們時，它可以讓形狀出現和消失，循環。

要使用宏，我必須將我的形狀粘貼到一張空幻燈片中。

我想改進宏並可以在具有其他形狀的幻燈片中使用它，select 形狀並將宏應用於它們，但不適用於未選擇形狀的 rest。

任何想法？ 謝謝

這是代碼

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

Answer 1

使用以下代碼獲取活動幻燈片中所有選定的形狀：

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

Next

如果你想使用計數器：

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

Answer 2

謝謝，根據你的計數器模式，我可以讓宏按我的意願工作

Sub Createanimation()

Set oSld = Application.ActiveWindow.View.Slide


Dim Shp As Shape, SelectedShapes As Shapes

Z = ActiveWindow.Selection.ShapeRange.Count


For i = 1 To Z

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



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

Next i

ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue
ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue


End Sub