VBA Pulse Animation en PowerPoint 2013 con Excel 2013


3

Espero estar en el SE correcto. Las publicaciones que encontré me dirigieron a publicar aquí.

BLUF: Estoy tratando de usar una instrucción if / else para aplicar / eliminar la animación de pulso en un objeto específico en PowerPoint.

Antecedentes: el código vive en un documento de Excel porque lo estoy usando como un simple firewall figurativo básico para evitar que los empleados jueguen con las diapositivas. Quiero un documento de actualización en vivo que inserte información en una diapositiva de PowerPoint en ejecución y actualice el texto en cuanto al estado del estado del sitio específico (arriba o abajo). Hice un simple botón arriba / abajo que solo cambia entre UP / DN en la celda y lo alimenta a otras celdas para determinar qué hacer con los datos. Luego, un botón de macro ejecuta el código y actualiza el texto en PowerPoint.

Buenas noticias: todo funciona muy bien (aparte de la animación). El texto cambia (palabras y color) mientras se ejecuta el PowerPoint y el bloqueo del documento de Excel evita que los empleados jueguen con cualquier configuración.

Parte principal del código en cuestión:

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

La instrucción for se ejecuta a través de las celdas donde llamo la diapositiva, la forma y el texto de forma específicos. El nombre descriptivo es una repetición para ejecutar IF / Else.

Si cambio el estado a DN, se vuelve rojo, luego si lo cambio a ARRIBA, se vuelve verde.

Pude aplicar una animación usando este código en 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

El principal problema es que (comprensiblemente) aplica continuamente la animación, porque obviamente no hay verificación para ver si se aplica en este código. En segundo lugar, cuando traté de presentar oeff.delete, simplemente abandonó la animación y luego aplicó una no animación a todos los demás marcados como "ARRIBA" en el panel de animación de PowerPoint.

Entonces, 2 cosas:

  1. ¿Hay una opción para aplicar la animación de pulso? No pude encontrarlo en el área de la biblioteca msoAnimEffect.

  2. ¿Alguien tiene una forma elegante de activar o desactivar una animación usando este método que creé o tendré que encontrar una manera de establecer banderas, leer esas banderas y luego incorporarlas de alguna manera en la declaración If / Else?

Aquí hay una foto del Excel Doc:

ExcelExample

Respuestas:


1

Después de conversar con un amigo, pude hacer que las cosas funcionaran y agregué un poco de sabor extra.

Aquí está el código que hizo funcionar la animación:

'Nuevas variables
Texto de marca de tiempo tenue
Dim oeff As PowerPoint.Effect
Dim oshp As PowerPoint.Shape
Dim osld As PowerPoint.Slide
'Añadir efecto
Establezca oshp = pApp.ActivePresentation.Slides (shapelide) .Shapes (shapename)
Con pPreso.Slides (shapelide)
Establezca oeff = .TimeLine.MainSequence.AddEffect (Shape: = Shapes (shapename), effectID: _
= msoAnimEffectFlashBulb, disparador: = msoAnimTriggerWithPrevious)
Con oeff
'Dura para una diapositiva de 60 segundos
.Timing.RepeatDuration = 60
Terminar con
Terminar con

Luego la parte que elimina esas animaciones (¡gracias a CM!)

'Eliminar efecto
Establecer osld = pPreso.Slides (shapelide)
'El 28 es solo porque tengo otras 28 animaciones sucediendo que deberían quedarse
Si osld.TimeLine.MainSequence.Count> 28 Entonces
Para i = osld.TimeLine.MainSequence.Count To 29 Paso -1
Establezca oeff = osld.TimeLine.MainSequence (i)
If oeff.Shape.Name Like shapename Entonces
oeff.Delete
Terminara si
Siguiente yo
Terminara si

Espero que esto ayude a algunas personas por ahí.

Como beneficio adicional, agregué una marca de tiempo a la diapositiva para poder ver cuándo fue la última vez que se actualizó el estado utilizando este código (el objeto es el cuadro de texto 28 en todas las diapositivas y la marca de tiempo es la función "AHORA ()" en Excel en la celda H25):

Nota: esto está dentro del bucle principal For, pero fuera del If / Else = "DN" principal

timestamptext = (Sheet1.Range ("H" & 25) .Text)
pPreso.Slides (shapelide) .Shapes ("Cuadro de texto 28"). TextEffect.Text = timestamptext

Al usar nuestro sitio, usted reconoce que ha leído y comprende nuestra Política de Cookies y Política de Privacidad.
Licensed under cc by-sa 3.0 with attribution required.