Sub Auto_Play_PowerPoint()
    Dim oPP As Object, sPath As String
    Dim avFiles, li As Long
    Set oPP = CreateObject("PowerPoint.Application")
    sPath = oPP.Path
    oPP.Quit: Set oPP = Nothing
    avFiles = Application.GetOpenFilename("Power Point Files(*.ppt*;*.pps*),*.ppt*;*.pps*", , , , True)
    If VarType(avFiles) = vbBoolean Then Exit Sub
    For li = LBound(avFiles) To UBound(avFiles)
        Shell sPath & "\POWERPNT.EXE /s " & avFiles(li)
        DoEvents
    Next li
End Sub