Got some VBA code doing great work but lacking the ability to autoplay the video in slideshow mode. Also, since this is a slide used in a bigger kiosk kind of presentation in a loop, I need the slide to being able to execute the random video VBA code each time this slide # is called upon. Maybe I need a complete overhaul of this VBA code to reach my goal? Maybe I need a different perspective on how to achieve my goal? Hope someone can help me with this.

Kind regards, JB from the Netherlands

Sub ShowRandomMovie()
    Dim pptSlide As Slide
    Dim pptShape As Shape
    Dim movieFolder As String
    Dim movieFiles As Collection
    Dim movieFile As String
    Dim randomIndex As Integer
    Dim videoWidth As Single, videoHeight As Single
    Dim shapeLeft As Single, shapeTop As Single
    Dim playEffect As Effect

    ' Set the folder path containing the movies
    movieFolder = "C:UsersjohndoeVideos" ' Path to your video folder

    ' Initialize the collection to hold movie files
    Set movieFiles = New Collection

    ' Check if the folder path ends with a backslash, add one if not
    If Right(movieFolder, 1) <> "" Then movieFolder = movieFolder & ""

    ' Retrieve all MP4 files from the folder
    movieFile = Dir(movieFolder & "*.mp4")
    Do While movieFile <> ""
        movieFiles.Add movieFolder & movieFile
        movieFile = Dir
    Loop

    ' Exit if no movies found
    If movieFiles.Count = 0 Then
        MsgBox "No MP4 files found in the specified folder.", vbExclamation
        Exit Sub
    End If

    ' Randomly select an index
    Randomize
    randomIndex = Int((movieFiles.Count * Rnd) + 1)

    ' Get the selected movie file
    movieFile = movieFiles(randomIndex)

    ' Set the active slide to insert the video
    Set pptSlide = ActivePresentation.SlideShowWindow.View.Slide

    ' Remove any existing video shapes from the slide to avoid overlap
    Dim shp As Shape
    For Each shp In pptSlide.Shapes
        If shp.Type = msoMedia Then
            shp.Delete
        End If
    Next shp

    ' Set the video size to fill the entire slide (full screen)
    videoWidth = pptSlide.Master.Width
    videoHeight = pptSlide.Master.Height

    ' Position the video to cover the entire slide
    shapeLeft = 0
    shapeTop = 0

    ' Add the movie to the slide
    Set pptShape = pptSlide.Shapes.AddMediaObject2(Filename:=movieFile, _
                                                   LinkToFile:=msoFalse, _
                                                   SaveWithDocument:=msoTrue, _
                                                   Left:=shapeLeft, _
                                                   Top:=shapeTop, _
                                                   Width:=videoWidth, _
                                                   Height:=videoHeight)

    ' Ensure the video auto-starts and covers the full slide
    With pptShape
        .LockAspectRatio = msoFalse
        .Width = videoWidth
        .Height = videoHeight
    End With

    ' Add play effect to ensure video starts automatically with the slide
    Set playEffect = pptSlide.TimeLine.MainSequence.AddEffect(pptShape, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
    playEffect.Timing.TriggerType = msoAnimTriggerWithPrevious
    playEffect.Timing.Duration = 0 ' Set duration to 0 to start immediately

    ' Force the video to start automatically
    pptShape.AnimationSettings.PlaySettings.PlayOnEntry = msoTrue
    pptShape.AnimationSettings.PlaySettings.HideWhileNotPlaying = msoFalse
End Sub

Private Sub App_SlideShowNextSlide(ByVal Wn As SlideShowWindow)
    ' Check if the current slide is the one that should play the video
    If Wn.View.Slide.SlideIndex = 3 Then ' Change "3" to the index of your video slide
        ShowRandomMovie
    End If
End Sub