PPT파일 순서를 확인/정렬해서 합치기

관련: 지식인

 

https://konahn.tistory.com/entry/MergePPT

PPT 합치기

이전 글에서 PPT파일을 합치는 방법을 안내한 적이 있습니다.

 

PPT파일이 합쳐지는 순서를 마음대로 변경하고 싶을 때,

PPT파일 내부의 일부 슬라이드만 골라서 합치고 싶을 때,

PPT파일의 순서를 확실하게 확인하거나 정렬시키고 싶을 때가 있을 수 있습니다.

 

파일의 순서를 확실하게 하기 위해서 폴더를 선택하면 엑셀시트에 파일 목록을 나열하고 파일 순서를 직접 확인한 뒤에 나열된 혹은 정렬된 순서대로 합치도록 만들어 보았습니다. (인터페이스는 고프로파일명 변경화면을 재활용했습니다.)

​

첨부한 엑셀매크로파일(xlsm)을 파일속성에서 차단해제에 체크/확인한 후에 매크로를 허용해서 열어주세요.

​

1. Get PPTx List 를 눌러서 pptx 파일들이 있는 폴더를 선택합니다.

폴더이름을 클릭한 상태가 아니라 폴더 안에 들어가고 나서 '확인'을 누르세요.

​

2. Sort File List 를 눌러서 폴더명, 파일명, 확장자 순으로 정렬합니다.

원한다면 정렬을 생략해도 되고 엑셀 정렬 기능을 이용해서 다른 순서나 역순서로 순서를 조정합니다.

행을 복사해서 위치를 임의의 순서로 바꿔도 됩니다.

​

모든 슬라이드가 아니라 파일내의 일정 범위를 원할 경우 시작 슬라이드와 마지막 슬라이드 위치를 명시할 수 있습니다. 시작 슬라이드는 생략하면 1슬라이드부터로 인식하고 마지막 슬라이드위치는 생략하면 맨 끝 슬라이드까지 복사합니다. 시작 슬라이드에 2를 입력하면 2슬라이드부터 끝까지 복사됩니다.

​

3. Merge List를 눌러서 ppt파일들을 합칩니다.

새로운 파워포인트 파일에 모든 파일이 합쳐집니다.

​

기본 슬라이드 테마로 생성되어 다른 테마를 사용한 경우 원본과 달라질 수 있습니다.

(테마까지 가져오려면 직접 파일을 열어서 슬라이드를 붙여넣도록 코드를 수정해야 합니다.)

​

VBA코드:

Option Explicit

Sub getFolder()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .InitialFileName = ThisWorkbook.Path & Application.PathSeparator
        If .Show Then Range("A2") = .SelectedItems(1)
    End With
    If Len(Dir(Range("A2") & "\.")) Then Call getPPTList
End Sub

Function getPPTList()

    Dim mPath As String
    Dim mFile As String
    Dim Sht As Worksheet
    Dim i As Long

    Set Sht = ThisWorkbook.ActiveSheet
    Sht.UsedRange.Offset(4).ClearContents
    
    'mPath = ThisWorkbook.Path & Application.PathSeparator
    mPath = Sht.Range("A2").Value & Application.PathSeparator
    If mPath = "" Or Len(Dir(mPath)) = 0 Then MsgBox "경로가 존재하지 않습니다.": Exit Function
 On Error Resume Next
 
    mFile = Dir(mPath & "*.ppt?")
    i = 5
    Do While Len(mFile)
        
        Sht.Cells(i, 1).HorizontalAlignment = xlRight
        Sht.Cells(i, 1) = mPath
        Sht.Cells(i, 2) = Left(mFile, InStrRev(mFile, ".") - 1) 'filename
        Sht.Cells(i, 3) = Mid(mFile, InStrRev(mFile, "."))       '.ext
        mFile = Dir
        i = i + 1
    Loop

End Function

Sub MergeFiles()

    Dim Sht As Worksheet
    Dim lastRow As Range
    Dim sFile As String
    Dim rng As Range
    Dim i As Integer, sStart&, sEnd&
    Dim ppt As Object  'PowerPoint.Application
    Dim pres As Object  'PowerPoint.Presentation
    
    Set ppt = CreateObject("PowerPoint.Application")
    If ppt Is Nothing Then Exit Sub
    'ppt.Visible = msoFalse
    Set pres = ppt.Presentations.Add()

    Set Sht = ActiveSheet
    Set lastRow = Sht.Cells(Sht.Rows.Count, "B").End(xlUp)
    If lastRow.Row < 5 Then Exit Sub
    
    For Each rng In Sht.Range("B5", lastRow)
        sFile = rng.Offset(, -1) & rng & rng.Offset(, 1)
        If Len(Dir(sFile)) = 0 Then
            AppActivate Sht.Parent.Name
            If MsgBox("파일이 존재하지 않습니다: " & vbNewLine & sFile & _
                vbNewLine & vbNewLine & "작업을 중단할까요?", _
                vbYesNo) = vbYes Then Exit For
        Else
            sStart = rng.Offset(, 2)
            If sStart = 0 Then sStart = 1
            sEnd = rng.Offset(, 3)
            If sEnd = 0 Then sEnd = -1
            '맨 뒤에 파일 넣기
            pres.Slides.InsertFromFile sFile, pres.Slides.Count, sStart, sEnd
            i = i + 1
        End If
    Next rng
    
    If i > 0 Then
        AppActivate Sht.Parent.Name
        MsgBox i & "개의 파일을 합쳤습니다."
        ppt.Activate
    Else
        ppt.Quit
    End If
    
    Set ppt = Nothing
    ThisWorkbook.Saved = True
End Sub

Sub SortFileList()

    Dim Sht As Worksheet
    Dim lastRow As Range
    Dim rng As Range
    Dim i As Integer

    Set Sht = ActiveSheet
    Set lastRow = Sht.Cells(Sht.Rows.Count, "B").End(xlUp)
    If lastRow.Row < 5 Then Exit Sub
    
    Sht.Range("A5:E" & lastRow.Row).Sort _
        Key1:=Sht.Range("A5"), Key2:=Sht.Range("B5"), Key3:=Sht.Range("C5")
        
 End Sub

 

엑셀 매크로파일 첨부합니다.

 

MergePPTx1.xlsm

0.03MB