Как надежно изменить цвет заливки прямоугольника с помощью временной шкалы анимации через PowerPoint VBA - PullRequest
Новая
       37

Как надежно изменить цвет заливки прямоугольника с помощью временной шкалы анимации через PowerPoint VBA

0 голосов
/ 08 июля 2020

Я кодирую с помощью PowerPoint VBA, но у меня возникают трудности с попыткой надежно изменить цвет заливки фигуры (прямоугольника) с помощью временной шкалы анимации и msoAnimEffectChangeFillColor. Происходит то, что в первом случае эффект работает так, как задумано, но повторение одной и той же формы (обычно второй или третий запуск) приводит к смене цвета замены на альтернативный нежелательный цвет (обычно оранжевый). Я считаю, что это легко воспроизвести.

Если вы создаете PowerPoint и вставляете заполненный прямоугольник и запускаете макрос ниже (например, при щелчке по прямоугольнику) - первый щелчок меняет цвет на предполагаемый (здесь красный). Однако, если вы продолжите запускать макрос, цвет (в конце концов) изменится на оранжевый! Буду признателен, если кто-нибудь сможет объяснить, почему это происходит, и если есть решение, дайте мне знать! Другое наблюдение, которое я сделал, заключается в том, что мне часто приходится перезагружать проект в Visual Basi c Editor, чтобы анимация снова начала работать. 

Dim oshp As Shape
Dim oeff As Effect
Dim MyDocument As Slide

Sub rectangle()

'I don't know if we need this first bit of code but it removes any existing animations on the current timeline'
Dim i As Integer
For i = ActivePresentation.Slides(1).TimeLine.MainSequence.Count To 1 Step -1
ActivePresentation.Slides(1).TimeLine.MainSequence(1).Delete
Next i

'This is the code to create the animation.
Set MyDocument = ActivePresentation.Slides(1)
Set oshp = MyDocument.Shapes("Rectangle 3")
Set oeff = MyDocument.TimeLine.MainSequence.AddEffect _
(Shape:=oshp, effectid:=msoAnimEffectChangeFillColor, trigger:=msoAnimTriggerWithPrevious)
oeff.EffectParameters.Color2.RGB = RGB(255, 0, 0)
oeff.Timing.Duration = 0.25
oeff.Timing.TriggerDelayTime = 0.5

End Sub

1 Ответ

1 голос
/ 09 июля 2020

Прошу написать, что я нашел ответ на свой вопрос и он может быть полезен другим людям. Решение состоит в том, чтобы объявить переменные внутри Sub. Я не уверен, что существует правило, согласно которому так должно быть всегда. Итак, код выглядит так: 

Sub rectangle()

Dim oshp As Shape
Dim oeff As Effect
Dim MyDocument As Slide

'This first bit of code removes any existing animations on the current
'timeline and is not part of the animation.
Dim i As Integer
For i = ActivePresentation.Slides(1).TimeLine.MainSequence.Count To 1 Step -1
ActivePresentation.Slides(1).TimeLine.MainSequence(1).Delete
Next i

'This is the code to create the animation.
Set MyDocument = ActivePresentation.Slides(1)
Set oshp = MyDocument.Shapes("Rectangle 3")
Set oeff = MyDocument.TimeLine.MainSequence.AddEffect _
(Shape:=oshp, effectid:=msoAnimEffectChangeFillColor, trigger:=msoAnimTriggerWithPrevious)
oeff.EffectParameters.Color2.RGB = RGB(255, 0, 0)
oeff.Timing.Duration = 0.25
oeff.Timing.TriggerDelayTime = 0.5

End Sub
...