폴더 내의 모든 PPT를 PDF로 일괄로 내보내기

1. 일단 윈도우의 기본 프린터를 가상 PDF프린터로 설정하고

모든 PPT를 인쇄 프린터로 보내는 방법을 시도해볼 수 있겠습니다.

 

그런데 저장할 pdf 파일명을 계속 물어보게되어서 불편하겠습니다.

​

​

2. VBA 매크로를 이용할 수 있습니다.

(지난번 ppt를 비디오로 내보내기하는 소스를 재활용했습니다.)

 

2-1. pptm 첨부파일을 다운 받아서 파일을 우클릭> 파일속성에서 차단해제 체크 > 확인 후에 매크로 허용해서 엽니다.

 

2-2. Alt-F8을 누르고 매크로 위치는 첨부한 pptm을 선택하고 Export2PDF를 실행합니다.

 

2-3. ppt파일들이 모여 있는 폴더를 선택합니다.

 

2-4. 변환 결과 확인 : Ctrl+G 디버그창

>> Source Folder: C:\Users\사용자\Desktop\Export2Videos
>> Target Folder: C:\Users\사용자\Desktop\Export2Videos
23-12-17 14:36:12 (0001) Converting Export2Videos1.pptm to Export2Videos1.pdf
23-12-17 14:36:14 (0002) Converting Export2Videos1.pptx to Export2Videos1_45277.6084953704.pdf
23-12-17 14:36:14 (0003) Converting Export2Videos2.pptx to Export2Videos2.pdf
23-12-17 14:36:14 (0004) Converting 프레젠테이션1.ppt to 프레젠테이션1.pdf
23-12-17 14:36:15 (0005) Converting 프레젠테이션1.pptx to 프레젠테이션1_45277.6085069444.pdf
23-12-17 14:36:15 5 file(s) processed.

 

 

VBA 코드 참고:

Option Explicit
 
'Const TargetFolder = "C:\Temp"     '따로 결과파일을 저장할 폴더가 있을 경우
Const TargetFolder = ""             'ppt파일이 있는 폴더에 저장

Const Overwrite = False             '대상 파일이 존재할 때 덮어쓸지 여부

Const Ext = ".pdf"                  '변환 확장자

Sub Export2PDF()

    Dim tPrs As Presentation, sPrs As Presentation
    Dim sPpt As String, sPDF As String
    Dim sPath As String, tPath As String
    Dim PR As PrintRange
    Dim Cnt As Long, L As Long
    On Error GoTo Oops
    
    Set tPrs = ActivePresentation
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Filters.Clear
        .AllowMultiSelect = False
        .ButtonName = "현재폴더 선택"
        .InitialFileName = tPrs.Path & "\"
        .Title = "동영상으로 내보낼 ppt파일이 들어있는 폴더 선택"
        If .Show = -1 Then sPath = .SelectedItems(1)
    End With
    'sPath = tPrs.Path
    If sPath = "" Then Exit Sub
    Debug.Print ">> Source Folder: " & sPath
    tPath = IIf(TargetFolder = "", sPath, TargetFolder)
    Debug.Print ">> Target Folder: " & tPath
    
    '첫번째 파일 검색
    sPpt = Dir(sPath & "\*.ppt?")
    'Debug.Print sPpt
    While Len(sPpt) > 0
        
        If FileExistsGA(sPath & "\" & sPpt) And _
            sPath & "\" & sPpt <> tPrs.FullName Then
            Set sPrs = Presentations.Open(FileName:=sPath & "\" & sPpt, ReadOnly:=msoTrue, _
                Untitled:=msoFalse, WithWindow:=msoTrue)
            
            If Not sPrs Is Nothing Then
                Cnt = Cnt + 1
                'ppt이름.PDF 으로 저장
                sPDF = Left(sPrs.Name, InStrRev(sPrs.Name, ".") - 1)
                If Overwrite = False And FileExistsGA(tPath & "\" & sPDF & Ext) Then _
                    sPDF = sPDF & "_" & CDbl(Now)
                'sPDF = sPDF & Ext   '.PDF
                
                Debug.Print Format(Now, "YY-MM-DD HH:NN:SS") & " (" & Format(Cnt, "0000") & _
                    ") Converting " & sPrs.Name & " to " & sPDF & Ext
                
                'For L = 1 To sPrs.Slides.Count
                '    Set PR = .Ranges.Add(sld.SlideIndex, sld.SlideIndex)
                'Next L
                sPrs.ExportAsFixedFormat2 Path:=tPath & "\" & sPDF & Ext, _
                    FixedFormatType:=ppFixedFormatTypePDF, _
                    PrintHiddenSlides:=msoTrue, _
                    BitmapMissingFonts:=True
                    
                    ', PrintRange:=PR, RangeType:=ppPrintSlideRange
 
                DoEvents
 
                sPrs.Close
            End If
        
        End If
        
        '다음 파일 검색
        sPpt = Dir()
        'Debug.Print sPpt
    Wend

    Debug.Print Format(Now, "YY/MM/DD HH:NN:SS") & " " & Cnt & " file(s) processed."

Oops:
    If Err.Number Then MsgBox Err.Description

End Sub

Function FileExistsGA(ByVal FileSpec As String) As Boolean
  ' Karl Peterson MS VB MVP
  Dim Attr As Long
  ' Guard against bad FileSpec by ignoring errors
  ' retrieving its attributes.
  On Error Resume Next
  Attr = GetAttr(FileSpec)
  If Err.Number = 0 Then
    ' No error, so something was found.
    ' If Directory attribute set, then not a file.
    FileExistsGA = Not ((Attr And vbDirectory) = vbDirectory)
  End If
  On Error GoTo 0
End Function

 

주의:

2010 등 하위 버전에서는 위 코드에서 sPrs.ExportAsFixedFormat2 대신 sPrs.ExportAsFixedFormat 를 사용해야 합니다.

 

아래에 pptm파일 첨부합니다.

Export2PDF1.pptm

0.04MB