VBA Macro for PowerPoint to format videos

Question

VBA Macro for PowerPoint to format videos

Guille01 0

I 'm trying to format automatically all the videos in a PowerPoint presentation doing the following:

Maximize the size of the video in the slide.
Center the video in the slide.
Playing the video in a continuous loop.
Playing the video automatically when the slide starts.

The first 3 work fine, but the fourth does not.

Any idea what could be the problem?

Here is the code I'm using:

Sub formatVideos()

Dim miDiapositiva As Slide

Dim miForma As Shape

'ancho diapositiva

anchoDiapositiva = ActivePresentation.PageSetup.SlideWidth

altoDiapositiva = ActivePresentation.PageSetup.SlideHeight

' Itera a través de todas las diapositivas

For Each miDiapositiva In ActivePresentation.Slides

' Itera a través de todas las formas en la diapositiva actual

For Each miForma In miDiapositiva.Shapes

' Verifica si la forma es un objeto de video

If miForma.Type = msoMedia Then

miForma.AnimationSettings.Animate = msoTrue

' Cambia el tamaño del video (por ejemplo, 640x480 píxeles)

miForma.Width = anchoDiapositiva

miForma.Height = altoDiapositiva

' Centra

anchoVideo = miForma.Width

miForma.Left = 0

' Centra el video verticalmente

altoVideo = miForma.Height

miForma.Top = 0

'Playing continuously

miForma.AnimationSettings.PlaySettings.LoopUntilStopped = msoTrue

'starts automatically

miForma.AnimationSettings.PlaySettings.PlayOnEntry = msoTrue

End If

Next miForma

Next miDiapositiva

End Sub

2 answers

Your answer

Answer 1

John Korchok 6,416 Volunteer Moderator

AnimationSettings won't do it. Here's how to set a video to autoplay:

Sub PlayVideoAutomatically()
     Dim oShp As Shape
     Set oShp = ActivePresentation.Slides(2).Shapes(1)     
     ActivePresentation.Slides(2).TimeLine.MainSequence.AddEffect Shape:=oShp, effectId:=msoAnimEffectMediaPlay, trigger:=msoAnimTriggerAfterPrevious 
End Sub

Guille01 0 Reputation points

2024-03-07T21:28:02.21+00:00

I modify the code you sent to me to make it work for each slide, but it still is not working. Now is playing the video twice. But the property in each video stays with no change.

I want to change the property in the video object, as I changed the property "LoopUntilStopped", so the macro is run just once and the objects (video objects) stays with the new property changed.

Answer 2

To autoplay all videos, the following script worked for me:

Sub AutoPlayAllVideos()
    Dim sld As Slide
    Dim sh As Shape
    Dim AnimationEffect As Effect
    Dim Behaviour As AnimationBehavior
    
    For Each sld In ActivePresentation.Slides
        For Each sh In sld.Shapes
            If sh.Type = msoMedia Then
                If sh.MediaType = ppMediaTypeMovie Then
                    With sh.AnimationSettings
                        .AdvanceMode = ppAdvanceOnTime
                        .AdvanceTime = 0
                        With .PlaySettings
                            .PlayOnEntry = msoTrue
                            .PauseAnimation = msoFalse
                            .LoopUntilStopped = msoFalse
                        End With
                    End With
                End If
            End If
        Next sh
    Next sld
End Sub

I tried only setting .PlayOnEntry = msoTrue , but it wasn't enough. It seems that you have to add the .AdvanceMode = ppAdvanceOnTime, so the animation starts automatically after some time, and then set .AdvanceTime = 0, so the "some time" becomes imediatelly at start.

I hope it helps!

Share via

VBA Macro for PowerPoint to format videos

2 answers

Your answer