파워포인트VBA : 원하는 pptx 파일을 복수의 이미지 파일로 변환

파워포인트VBA : 원하는 pptx 파일을 복수의 이미지 파일로 변환

‘Imports Microsoft.Office.Interop.PowerPoint

Dim staticResult

Public Sub doTest()

    Dim filePath

    On Error Resume Next

    Const xlDoNotSaveChanges = 0
    Const wdFormatPDF = 32
    Const ppSaveAsJPG = 17
    Const xlHtml = 14
    Const wiFileTypeJPG = 6
    Const wdRevisionsViewFinal = 0
   
    Dim fso, objWord, objDoc
   
    Set fso = CreateObject(“Scripting.FileSystemObject”)
    Set objPowerPoint = CreateObject(“PowerPoint.Application”)
   
    ‘filePath = WScript.Arguments.Item(A)
   
    filePath = “C:\원하는파일이있는경로\test.pptx”
   
    objPowerPoint.Visible = True
   
    ‘sPdfFile = fso.GetParentFolderName(filePath) + “\” + fso.GetBaseName(filePath) + “.pdf”
    sPdfFile = fso.GetParentFolderName(filePath) + “\” + fso.GetBaseName(filePath) + “11”
   
    ‘If WScript.Arguments.Count = 0 Then
        ‘WScript.Quit
    ‘Else
        ‘For A = 0 To (WScript.Arguments.Count – 1)
            If fso.FileExists(filePath) Then

                ‘convert_slide filePath, sPdfFile, 1
               
                Save_PowerPoint_Slide_as_Images (filePath)

                ‘Set objDoc = objPowerPoint.Presentations.Open(filePath, , , FALSE)
                ‘Set wview = wdoc.ActiveWindow.View
                ‘wview.ShowRevisionsAndComments = False
                ‘wview.RevisionsView = wdRevisionsViewFinal
                ‘objDoc.SaveAs sPdfFile, wdFormatPDF, TRUE
                ‘objDoc.SaveAs sPdfFile, 17, TRUE
                ‘objDoc.Close
            Else
                MsgBox (“파일이 없습니다.”)
            End If
        ‘Next
    ‘End If
   
    ‘objPowerPoint.Quit
    Set fso = Nothing
    Set objPowerPoint = Nothing

    If Err.Number <> 0 Then
        Dim erroMsg, oShell, commadMsg
        erroMsg = “ppt_print.vbs Error: ” & filePath
   
        Set oShell = WScript.CreateObject(“WSCript.shell”)
        commadMsg = “EVENTCREATE /T WARNING /ID ” & Err.Number & ” /L APPLICATION /D ” & Chr(34) & erroMsg & Chr(34)
   
        oShell.Run commadMsg
        Set oShell = Nothing
       
        Err.Clear
    End If
End Sub

Sub Save_PowerPoint_Slide_as_Images(path As String)

    Dim pptapplication As New PowerPoint.Application
    Dim prsPres As PowerPoint.Presentation

    Set prsPres = pptapplication.Presentations.Open(path, True, False, False)
   
   
    Dim sImagePath As String
    Dim sImageName As String
    Dim sPrefix As String
    Dim oSlide As Slide ‘* Slide Object
    Dim lScaleWidth As Long ‘* Scale Width
    Dim lScaleHeight As Long ‘* Scale Height
    On Error GoTo Err_ImageSave

    Dim prePath
    prePath = Replace(path, “.pptx”, “”)
   
    Dim cnt
    cnt = 0
   
    ‘For Each oSlide In ActivePresentation.Slides ‘현재 프레젠테이션
   
    For Each oSlide In prsPres.Slides
        cnt = cnt + 1
        sImageName = prePath & “-” & cnt & “.jpg”
        oSlide.Export sImageName, “JPG”
    Next oSlide

Err_ImageSave:
    If Err <> 0 Then
        MsgBox Err.Description
    End If
End Sub