Animação por Pulso VBA no PowerPoint 2013 usando o Excel 2013

Question

Espero que esteja na direita. As postagens que encontrei me orientaram a postar aqui.

BLUF: Estou tentando usar uma instrução if / else para aplicar / remover a animação de pulso em um objeto específico no PowerPoint.

Background: O código está em um documento do Excel porque estou usando isso como um simples firewall figurativo básico para impedir que os funcionários mexam nos slides. Eu quero um documento de atualização ao vivo que envia informações para um slide do PowerPoint em execução e atualiza o texto quanto ao status do status do site específico (para cima ou para baixo). Eu fiz um simples botão para cima / para baixo que só muda entre UP / DN na célula e alimenta isso em outras células para determinar o que fazer com os dados. Em seguida, um botão de macro executa o código e atualiza o texto no PowerPoint.

Boas notícias: tudo funciona muito bem (além da animação). O texto muda (palavras e cores) enquanto o PowerPoint está sendo executado e o bloqueio do documento do Excel impede que os funcionários mexam nas configurações.

Parte principal do código em questão:

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

A instrução for percorre as células onde eu chamo o texto específico de slide, forma e forma. O nome amigável é uma repetição para executar o IF / else.

Se eu alterar o status para DN, ele ficará vermelho e, se eu alterá-lo para UP, ele ficará verde.

Consegui obter uma animação aplicada usando este código no 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

O principal problema é que (compreensivelmente) aplica continuamente a animação, porque obviamente não há verificação para ver se aplicado neste código. Em segundo lugar, quando tentei introduzir oeff.delete, ele simplesmente deixou a animação e aplicou uma animação não a todos os outros marcados como "UP" no painel de animação do PowerPoint.

Então, duas coisas:

1. Existe uma opção para aplicar a animação de pulso? Não consegui encontrá-lo na área da biblioteca msoAnimEffect.

2. Alguém tem uma maneira elegante de ativar ou desativar uma animação usando esse método que criei ou precisarei descobrir uma maneira de definir sinalizadores, ler esses sinalizadores e, de alguma forma, incorporá-los ao If / Else? declaração?

Aqui está uma foto do documento do Excel:

    

Answer 1

Depois de conversar com um amigo, consegui fazer com que as coisas funcionassem e adicionei um pouco mais de tempero.

Aqui está o código que fez a animação funcionar:

'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

Em seguida, a parte que se livra dessas animações (graças ao 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

Espero que isso ajude algumas pessoas por aí.

Como bônus, adicionei um registro de data e hora ao slide para que eu pudesse ver quando a última vez que o status foi atualizado usando esse código (o objeto é a caixa de texto 28 em todos os slides e o carimbo de data / hora é o "NOW ()") função no Excel na célula H25):

Nota: isso está dentro do loop Main For, mas fora do main If / Else="DN"

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