Импульсная анимация VBA в PowerPoint 2013 с использованием Excel 2013

Question

Я надеюсь, что я в правильном SE. Посты, которые я нашел, направили меня на пост здесь.

BLUF: я пытаюсь использовать оператор if/else для применения / удаления импульсной анимации для определенного объекта в PowerPoint.

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

Хорошие новости: все отлично работает (кроме анимации). Текст изменяется (слова и цвет) во время работы PowerPoint, и блокировка документа Excel предотвращает путаницу с настройками.

Основная часть кода в вопросе:

For Each c In Sheet1.Range("a2:a" & Sheet1.Range("a" & Rows.Count).End(xlUp).Row)

shapeslide = Sheet1.Range("a" & c.Row)
shapename = Sheet1.Range("b" & c.Row)
shapetext = (Sheet1.Range("c" & c.Row).Text)
friendlyname = Sheet1.Range("d" & c.Row)
pPreso.Slides(shapeslide).Shapes(shapename).TextEffect.Text = shapetext

If (friendlyname = "DN") Then
pPreso.Slides(shapeslide).Shapes(shapename).TextFrame.TextRange.Font.Color.RGB = RGB(255, 0, 0)

'The porttion below worked, but it is not animation (not as cool)
'pPreso.Slides(shapeslide).Shapes(shapename).TextEffect.PresetTextEffect = 4
'pPreso.Slides(shapeslide).Shapes(shapename).TextEffectFormat = msoAnimEffectBoldFlash

Else
pPreso.Slides(shapeslide).Shapes(shapename).TextFrame.TextRange.Font.Color.RGB = RGB(0, 255, 0)

End If

Next c

Оператор for проходит через ячейки, где я вызываю определенный слайд, фигуру и текст фигуры. Дружественное имя - это повторение IF/Else.

Если я изменяю статус на DN, он становится красным, а если я изменяю его на UP, он становится зеленым.

Мне удалось применить анимацию с помощью этого кода в If/Else:

Dim oeff As Effect
Dim osld As Shape
Set osld = ppapp.ActivePresentation.Slides(shapeslide).Shapes(shapename)
With pPreso.Slides(shapeslide)
Set oeff = .TimeLine.MainSequence.AddEffect(Shape:=.Shapes(shapename),_ effectID:=msoAnimEffectBoldFlash, trigger:=msoAnimTriggerAfterPrevious)
With oeff
.Timing.RepeatDuration = 25
End With
End With

Основная проблема заключается в том, что (по понятным причинам) он постоянно применяет анимацию, потому что, очевидно, нет никакой проверки, чтобы увидеть, применяется ли этот код. Во-вторых, когда я попытался представить oeff.delete, он просто оставил анимацию, а затем применил не анимацию ко всем остальным, помеченным как "UP" на панели анимации PowerPoint.

Итак, 2 вещи:

1. Есть ли возможность применить импульсную анимацию? Я не смог найти его в области библиотеки msoAnimEffect.

2. Есть ли у кого-нибудь элегантный способ включить или отключить анимацию с помощью этого метода, который я создал, или мне нужно будет найти способ установить флаги, прочитать эти флаги, а затем каким-то образом включить их в оператор If/Else?

Вот фотография Excel Doc:

Answer 1

Посовещавшись с другом, я смог начать работу и добавил немного дополнительной специи.

Вот код, который запустил анимацию:

'New Variables
Dim timestamptext
Dim oeff As PowerPoint.Effect
Dim oshp As PowerPoint.Shape
Dim osld As PowerPoint.Slide
'Add Effect
Set oshp = pApp.ActivePresentation.Slides(shapeslide).Shapes(shapename)
With pPreso.Slides(shapeslide)
Set oeff = .TimeLine.MainSequence.AddEffect(Shape:=Shapes(shapename),effectID:_
=msoAnimEffectFlashBulb,trigger:=msoAnimTriggerWithPrevious)
With oeff
'Lasts for a 60 second slide
.Timing.RepeatDuration = 60
End With
End With

Затем часть, которая избавляется от этих анимаций (спасибо CM!)

'Delete Effect
Set osld = pPreso.Slides(shapeslide)
'The 28 is only because I have 28 other animations happening that should stay
If osld.TimeLine.MainSequence.Count>28 Then
For i = osld.TimeLine.MainSequence.Count To 29 Step -1
Set oeff = osld.TimeLine.MainSequence(i)
If oeff.Shape.Name Like shapename Then
oeff.Delete
End If
Next i
End If

Надеюсь, что это помогает некоторым людям там.

В качестве бонуса я добавил метку времени к слайду, чтобы я мог видеть, когда в последний раз статус обновлялся, используя этот код (объект - текстовое поле 28 на всех слайдах, а метка времени - это функция «NOW ()» в Excel в ячейке H25):

Примечание: это внутри цикла Main For, но вне основного If/Else = "DN"

timestamptext = (Sheet1.Range("H"&25).Text)
pPreso.Slides(shapeslide).Shapes("Text Box 28").TextEffect.Text = timestamptext