[PowerPoint] 슬라이드별 동영상 내보내기 VBA 매크로

기능

PPT 슬라이드별로 바탕화면에 ExportSlidesAsVideos 폴더에 동영상이 다운로드 된다.

 

alt+f11 매크로 창 열어서 복붙!

 

Sub ExportSlidesAsVideos()
    Dim ppt As Presentation
    Dim exportPath As String
    Dim i As Integer
    Dim tempPres As Presentation
    Dim WshShell As Object
    Dim desktopPath As String
    
    ' 바탕화면 경로 가져오기
    Set WshShell = CreateObject("WScript.Shell")
    desktopPath = WshShell.SpecialFolders("Desktop")
    
    ' 저장 폴더 지정
    exportPath = desktopPath & "\ExportSlidesAsVideos\"
    
    ' 폴더가 없으면 생성
    If Dir(exportPath, vbDirectory) = "" Then
        MkDir exportPath
    End If
    
    Set ppt = ActivePresentation
    
    ' 각 슬라이드 개별 동영상 저장
    For i = 1 To ppt.Slides.Count
        ' 임시 프레젠테이션 생성
        ppt.Slides(i).Copy
        Set tempPres = Presentations.Add
        tempPres.Slides.Paste
        
        ' 동영상으로 내보내기 (MP4)
        tempPres.CreateVideo exportPath & "Slide_" & i & ".mp4", _
                             True, , , 30, 60
        
        ' 동영상 생성 완료될 때까지 대기
        Do While tempPres.CreateVideoStatus = ppMediaTaskStatusInProgress
            DoEvents
        Loop
        
        ' 생성 완료 후 닫기
        If tempPres.CreateVideoStatus = ppMediaTaskStatusDone Then
            tempPres.Close
        End If
    Next i
    
    MsgBox "모든 슬라이드가 동영상으로 저장되었습니다!" & vbCrLf & "폴더 위치: " & exportPath
End Sub