vba 具有选定形状的宏幻灯片

Question

我有一个简单的宏，它可以让形状在你点击它们时循环出现和消失。

要使用宏，我必须将形状粘贴到空白幻灯片中。

我想改进宏，并可以在幻灯片中使用它与其他形状，select 形状并将宏应用于它们，但不适用于其他未select 形状.

有什么想法吗？谢谢

这是代码

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

vba 具有选定形状的宏幻灯片

vba macro powerpoint with selected shapes

powerpoint

vba