具有选定形状的 vba 宏 powerpoint答案

【问题标题】：vba macro powerpoint with selected shapes具有选定形状的 vba 宏 powerpoint
【发布时间】：2019-11-05 18:04:33
【问题描述】：

我有一个简单的宏，当你点击它们时，它会循环显示和消失。

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

我想改进宏并可以在幻灯片中使用它与其他形状，选择形状并将宏应用到它们，但不适用于其余未选择的形状。

有什么想法吗？谢谢

这里是代码

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

【问题讨论】：

标签： vba powerpoint

【解决方案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

【讨论】：

【解决方案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

【讨论】：