관련: 지식인
https://konahn.tistory.com/entry/MergePPT
이전 글에서 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
엑셀 매크로파일 첨부합니다.
'XLS+VBA' 카테고리의 다른 글
온라인 이미지를 다운로드하여 아래로 이어 붙인 상품 이미지 일괄 생성 (0) | 2024.02.14 |
---|---|
엑셀에서 ppt의 특정 페이지를 링크 (0) | 2023.11.21 |
juso.go.kr이용 한글주소 ↔ 영어주소 변환 (0) | 2023.06.15 |
영어단어와 뜻 OCR인식 결과 정리하기 (0) | 2023.06.12 |
구글 이미지 검색 결과 가져오기 (0) | 2023.02.01 |
JsonBag 클래스를 이용한 Json데이터 파싱 (0) | 2023.01.01 |
연결 끊어진 차트의 엑셀 데이터 복구 (0) | 2022.07.26 |
엑셀 데이터를 JSON형식으로 변환 (2) | 2022.01.13 |
최근댓글