文件夹内有n个MP4，如何用vba代码，把这些视频批量插入到ppt

zzpsx

背课文.rar (884.39 KB, 下载次数: 1)

2023-10-17 07:32 上传

点击文件名下载附件

文件夹内有n个MP4，如何用vba代码，把这些视频批量插入到ppt中，每个ppt页面插入一个MP4。

zzpsx

Sub ppt批量插入视频()
    ' 声明变量
    Dim folderPath As String
    Dim videoFile As String
    Dim slideIndex As Integer
    Dim pptLayout As CustomLayout
    Dim videoShape As Shape
    ' 指定包含视频的文件夹路径
    folderPath = "C:\Users\Administrator\Desktop\背课文\"  ' <-- 这里修改为你的视频文件夹路径
    ' 确保路径以反斜杠结尾
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    ' 设置要查找的视频文件类型
    videoFile = Dir(folderPath & "*.mp4") ' <-- 如果你的视频格式不同，请在这里修改
    ' 获取当前活动演示文稿中使用的幻灯片布局
    Set pptLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(1)
    ' 循环遍历文件夹中的每个视频文件
    slideIndex = 1
    Do While videoFile <> ""
        ' 在演示文稿中插入新幻灯片
        Set newSlide = ActivePresentation.Slides.AddSlide(slideIndex, pptLayout)
        ' 在新幻灯片中插入视频
        Set videoShape = newSlide.Shapes.AddMediaObject2(folderPath & videoFile, _
                                                         MsoTriState.msoFalse, _
                                                         MsoTriState.msoCTrue, _
                                                         200, 200, 480, 320) '你可以根据需要修改视频的位置和大小
        ' 调整视频播放设置
        With videoShape.AnimationSettings.PlaySettings
            .PlayOnEntry = msoTrue
            .PauseAnimation = msoFalse
            .LoopUntilStopped = msoCTrue
        End With
        ' 获取下一个视频文件
        videoFile = Dir
        slideIndex = slideIndex + 1
    Loop
    ' 清理
    Set pptLayout = Nothing
    Set videoShape = Nothing
    MsgBox "All videos inserted into the presentation!", vbInformation
End Sub


以上代码希望能优化。