어떤 파워포인트 파일을 받아 보면, 슬라이드 장표 수에 비해 너무 큰 파일크기를 가져서 놀랄 때가 있다.
파일이 좀 커도 큰 상관없을 수도 있으나, 이 파일을 이메일로 보내거나 할 때 파일이 커서 못 보낸다거나 해서 난처할 때가 있다.
비정상적으로 파일이 큰 여러 가지 이유가 있을 수 있으나, 많은 경우는, 마스터 슬라이드가 너무 많아서 그렇다.
특히 여러 사람을 커지면서 각자 필요에 의해 마스터 슬라이드를 만들어 놓고, 이 파일을 계속 재활용하는 경우가 그런데, 메뉴의 "보기 > 슬라이드 마스트"를 눌러서 어떤 마스터 파일들이 있는지 확인해 보면, 사용되지 않는 마스터 파일이 굉장히 많이 있음을 볼 수 있을 것이다.
마스터 슬라이드에 마우스 커서를 올리면, 해당 슬라이드가 사용되는지 사용되는지를 알 수 있다. 해서, 수작업으로 일일이 슬라이드마다 사용되는 슬라이드인지 확인 후, 사용되지 않는 슬라이드면 마우스 우클릭해서 "레이이웃 삭제" 메뉴로 해당 마스터 슬라이드를 삭제해 나갈 수 있다.
그러나, 슬라이드 마스터 수가 수십 개가 넘는 파일의 겨우, 그리고 그러한 파일이 여러 개의 경우, 일일이 수작업으로 마스터 슬라이드를 삭제하는 것이 좀 번거로울 수 있다.
여기서 소개하는 VBA 프로그램은, 사용되지 않는 슬라이드 마스터를 모두 삭제해 주는 프로그램이다.
동작 방법은 이렇다.
1. 대상되는 파워 포인트 파일을 선택하게 한다.
2. VBA에서 해당 파일을 열고, 마스터 슬라이드를 조사한다.
3. 사용되는 슬라이드는 놔두고, 사용되지 않는 슬라이드는 삭제한다.
4. 파일을 저장한다.
여기서, 어떻게 사용되지 않는 마스터 슬라이드를 알아내는가가 핵심이다.
먼저, 파워포인트의 마스터 슬라이드가 어떻게 구성되어 있는지를 알아야 한다.
"마스터 슬라이드가 있고, 각 마스터 슬라이드마다 CustomLayout을 가지고 있는 형태"라는 것을 알아야 한다.
이 2가지(슬라이드 마스터, CustomerLayout) 모두를 조사해서, 사용되지 않는 것을 지워야 한다.
2가지 트릭을 사용했다.
(트릭1) CustomerLayout을 지우려고 할 때, 이미 사용되고 있으면 안 지워지고 에러가 발생한다는 것을 이용
(트릭 2) 파워포인트 본문 슬라이드마다, 어떤 슬라이드 마스터를 사용하고 있는지 정보가 있다. 이것을 이용.
(트릭 1에 대한 설명)
각 CustomerLayout은 Application.Designs(i).SlideMaster.CustomerLayouts(j)에 의해 접근이 가능하다.
for 루프를 이용해서 모든 CustomerLayout들에 대해 접근해서 삭제하려고 시도하고, 실패하면 for 루프를 계속 시도하도록 하면 된다.
On Error Resume Next
With ppt
For i = .Designs.Count To 1 Step -1
'1. check in the CustomLayout. Try to delete and if it is used then occur error. that is, if exist not deleted
For j = .Designs(i).SlideMaster.CustomLayouts.Count To 1 Step -1
.Designs(i).SlideMaster.CustomLayouts(j).Delete
Next j
Next i
End With
- 여기서 주의할 점은, CustomLayouts의 제일 마지막 인덱스에서 시작해서 차례로 내려가면서 지운다는 것에 주의.
- 만약 제일 작은 인덱스에서 시작해서 지운다면, 그 다음 지울 CustomLayout의 인덱스 번호가 바뀌어버려서, 제대로 지울 수가 없게 된다.
(트릭 2에 대한 설명)
본문 슬라이드에 사용된 마스터 슬라이드 번호가 어떻게 되는지는, 해당 슬라이드의 Design 정보를 보면 된다.
해서, 모든 본문 슬라이드에 대해서, 사용된 Design 인덱스를 모아두면, 이것이 사용된 마스터 슬라이드에 대한 집합 정보가 된다.
For Each oSlide In ppt.Slides
If Not IsInArray(oSlide.Design.Index, used_designs) Then
used_designs(i) = oSlide.Design.Index
i = i + 1
End If
Next oSlide
- 모든 사용된 Design.Index를 모아놔도 되나, 그렇게 되면 중복 Index가 발생하기에, 이미 들어가 Index는 안 들어가게 했다.
- IsInArray는 wellsr.com에서 찾은 코드로, Array에 해당 원소가 있는지를 확인하는 함수이다. for 루프로 일일이 뒤지는 것이기에 O(N)
- used_designs가 Index 순서대로 저장되는 구조이기에(큰 거에서 작은 순으로), 바이너리 서치를 사용하면 O(logN)에 동작하도록 isInArray를 개선할 수 있을 것이다. 그러나, 여기서는 그렇게 하지 않았다. ^^
이 프로그램을 짜면서, 처음에는 ArrayList를 사용했다. 그러나, 다른 PC에서 동작시켜보니 동작하지 않는 문제가 발생했다.
.Net 버전 문제로 예상되는데, 버전을 맞추는 노력보다는, ArrayList를 사용하지 않는 것이 더 편해서, 그냥 Array를 사용했다.
Array를 사용하는 경우 몇 가지 불편한 점이 있다.
- Array의 Count를 알아내기가 무척이나 어렵다는 점
- Array의 크기를 지정해줘야 한다는 점
- Array의 내에 해당 원소가 있는지 없는지를 알아내는 함수가 없다는 점
위와 같은 문제점을 해결하기 위해, 필요한 함수를 만들거나 인터넷에서 받아왔다.
전체 소스는 아래와 같다. (소스포함된 ppt 파일은 여기에)
Option Explicit
' remove unused master slide and shrink the file size
Sub RemoveUnusedMaster()
'1 select target files. multiple choice possible
Dim file_list() As Variant
file_list = GetFileList()
Dim file_list_cnt As Integer
file_list_cnt = ArrayLength(file_list)
If file_list_cnt = 0 Then
MsgBox "No file selected"
Exit Sub
End If
'2 delete unused master slide
Dim ppt As Object
Dim success_files() As Variant
ReDim success_files(file_list_cnt - 1)
On Error Resume Next
Dim i As Integer, j As Integer
i = 0
j = 0
For i = 0 To file_list_cnt
Set ppt = Presentations.Open(file_list(i))
Call RemoveMaster(ppt)
ppt.Save
ppt.Close
success_files(j) = file_list(i)
j = j + 1
Next i
ReDim Preserve success_files(j - 1)
MsgBox file_list_cnt & " files selected." & vbCrLf & " --> Success: " & j - 1
End Sub
' return all filepath selected by the user in the file selection dialog
Function GetFileList() As Variant()
Dim file_list() As Variant
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim item As Variant
With fd
If .Show = -1 Then 'end of user selection: OK or Cancel
If .SelectedItems.Count > 0 Then
ReDim file_list(.SelectedItems.Count - 1)
Dim i As Integer
i = 0
For Each item In .SelectedItems
file_list(i) = item
i = i + 1
Next item
Else
GetFileList = file_list
Exit Function
End If
End If
End With
GetFileList = file_list
End Function
'remove master slide in the given ppt file
Sub RemoveMaster(ppt As Object)
Dim i As Integer, j As Integer
'Dim used_masters As ArrayList
Dim used_masters() As Variant
used_masters = GetAllUsedMaster(ppt) 'get used master slide index
On Error Resume Next
With ppt
For i = .Designs.Count To 1 Step -1
'1. check in the CustomLayout. Try to delete and if it is used then occur error. that is, if exist not deleted
For j = .Designs(i).SlideMaster.CustomLayouts.Count To 1 Step -1
.Designs(i).SlideMaster.CustomLayouts(j).Delete
Next j
'2. for the master slide, check if it is used in the slide or not
If Not IsInArray(.Designs(i).Index, used_masters) Then
.Designs(i).Delete
End If
Next i
End With
End Sub
' Get all used master slides after checking for all slides
Function GetAllUsedMaster(ppt As Object) As Variant()
Dim slides_cnt As Integer
slides_cnt = ppt.Slides.Count
Dim used_designs() As Variant
ReDim used_designs(slides_cnt - 1)
Dim oSlide As Slide
Dim i As Integer
i = 0
For Each oSlide In ppt.Slides
If Not IsInArray(oSlide.Design.Index, used_designs) Then
used_designs(i) = oSlide.Design.Index
i = i + 1
End If
Next oSlide
ReDim Preserve used_designs(i - 1)
GetAllUsedMaster = used_designs
End Function
' https://excelmacromastery.com/
Function ArrayLength(arr As Variant) As Long
On Error GoTo eh
' Loop is used for multidimensional arrays. The Loop will terminate when a
' "Subscript out of Range" error occurs i.e. there are no more dimensions.
Dim i As Long, length As Long
length = 1
' Loop until no more dimensions
Do While True
i = i + 1
' If the array has no items then this line will throw an error
length = length * (UBound(arr, i) - LBound(arr, i) + 1)
' Set ArrayLength here to avoid returing 1 for an empty array
ArrayLength = length
Loop
Done:
Exit Function
eh:
If Err.Number = 13 Then ' Type Mismatch Error
Err.Raise vbObjectError, "ArrayLength" _
, "The argument passed to the ArrayLength function is not an array."
End If
End Function
Private Function IsInArray(valToBeFound As Variant, arr As Variant) As Boolean
'DEVELOPER: Ryan Wells (wellsr.com)
'DESCRIPTION: Function to check if a value is in an array of values
'INPUT: Pass the function a value to search for and an array of values of any data type.
'OUTPUT: True if is in array, false otherwise
Dim element As Variant
On Error GoTo IsInArrayError: 'array is empty
For Each element In arr
If element = valToBeFound Then
IsInArray = True
Exit Function
End If
Next element
Exit Function
IsInArrayError:
On Error GoTo 0
IsInArray = False
End Function
사용법은,
-끝-
'Programming > VBA(Excel, Powerpoint)' 카테고리의 다른 글
엑셀 매크로 소스코드 비밀번호 없이 추출하는 방법 (0) | 2022.10.21 |
---|---|
엑셀 VBA 코드 보호 및 크랙 방법 (20) | 2022.08.21 |
비밀번호에 의해 보호된 엑셀 파일 보호 해제 방법(Excel 97 - 2016) (0) | 2022.08.21 |
엑셀 파일 종류별(통합문서, 매크로, 추가기능) 파일 포맷 자료 (0) | 2022.08.21 |