VBA макрос PowerPoint с выбранными фигурами - PullRequest
0 голосов
/ 05 ноября 2019

У меня есть простой макрос, который заставляет фигуры появляться и исчезать при нажатии на них в цикле.

Чтобы использовать макрос, мне нужно вставить свои фигуры в пустой слайд.

Я хотел бы улучшить макрос и использовать его на слайде с другими фигурами, выбирать фигуры и применять к ним макрос, но не ко всем остальным невыбранным фигурам.

Любая идея? Спасибо

Вот код

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

Ответы [ 2 ]

0 голосов
/ 05 ноября 2019

Спасибо, основываясь на вашем режиме счетчика, я мог заставить макрос работать так, как я хотел

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

0 голосов
/ 05 ноября 2019

Используйте следующий код, чтобы получить все выбранные фигуры в активном слайде:

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...