Powerpoint로 작성된 보고서를 다른 부서나 다른 회사에 전달해야 하는 경우, 파일 편집을 막기 위해 PDF로 변환하거나, 그림으로 출력해서 보내는 경우가 있습니다.
때로는 특정 페이지만 그림 파일로 만들어서 메일 본문에 삽입하여 보내야 하는 경우도 있습니다. 그런데, 단순한 페이지라면 상관없지만, 여러 사진이 포함되어 있거나 도면과 같이 복잡한 페이지인 경우, 그림 파일로 출력하더라도 해상도가 높지 않아 선명하지 않게 출력됩니다.
매크로를 사용하게 되면, 원하는 슬라이드를 선택한 후
1) 해당 슬라이드만 해상도를 조절하여 출력하는 기능
2) 출력되는 그림 형식을 지정하는 기능
3) 출력되는 그림을 파일로 저장하거나 슬라이드의 개체로 삽입하는 기능
2) 출력되는 그림 형식을 지정하는 기능
3) 출력되는 그림을 파일로 저장하거나 슬라이드의 개체로 삽입하는 기능
등을 구현할 수 있습니다.
슬라이드를 그림으로 출력하는 기능을 조금만 응용하면, SlideRange 대신 ShapeRange를 사용하여 Powerpoint 파일 내에 있는 모든 사진이나 그림만 일괄적으로 파일로 출력할 수 있도록 구현할 수 있습니다.
'----------------------------------
'FileSystemObject를 사용하기 위해서는 VB 에디터의 '참조'에서 Microsoft Scripting Runtime을 체크해두어야 합니다. 파일로 출력할 때, 해당 폴더에 파일이 중복되는지 체크하기 위해서 필요합니다만, Dir과 같이 다른 방법을 사용할 수도 있습니다.
Sub Slide2Picture()
'선택한 슬라이드를 그림으로 변환하는 매크로입니다.
On Error GoTo ErrorHandler
Dim tW As Single, tH As Single, tFSO As New FileSystemObject, tFN As String, tFExt As String, tStr As String, tSlide As Slide, tSlideRange As SlideRange, tSh() As Shape, tPic() As String, i As Long, j As Long, tMSG
On Error GoTo ErrorHandler
Dim tW As Single, tH As Single, tFSO As New FileSystemObject, tFN As String, tFExt As String, tStr As String, tSlide As Slide, tSlideRange As SlideRange, tSh() As Shape, tPic() As String, i As Long, j As Long, tMSG
'슬라이드를 출력할 기본 해상도를 가로 1280으로 지정해두었습니다. 크면 클수록 해상도는 좋아지지만 파일 크기가 커지는 단점이 있습니다. Powerpoint 버전에 따라 최대 해상도에 제한이 있을 수 있습니다.
tW = 1280
'파일 출력 형식을 입력받습니다. EMF 파일로 저장하면 화질은 좋지만, 화면에 보이는 그대로 저장되지 않을 수 있습니다. 또한, 메일 본문에 첨부할 목적이라면 EMF 파일이 삽입되지 않을 수 있습니다.
Select Case MsgBox("PNG 파일로 출력하시겠습니까?" & vbCrLf & " -Yes : PNG (저화질, 고용량)" & vbCrLf & " -No : EMF 파일 (고화질, 저용량)" & vbCrLf & " -Cancel : 작업 취소", vbYesNoCancel, "출력 선택")
Case vbYes
Select Case MsgBox("PNG 파일로 출력하시겠습니까?" & vbCrLf & " -Yes : PNG (저화질, 고용량)" & vbCrLf & " -No : EMF 파일 (고화질, 저용량)" & vbCrLf & " -Cancel : 작업 취소", vbYesNoCancel, "출력 선택")
Case vbYes
'PNG 파일인 경우, 출력될 그림의 폭을 입력받습니다.
tFExt = "png"
tStr = InputBox("그림의 폭을 지정하세요.", "그림 크기 지정", tW)
If StrPtr(tStr) = 0 Or Val(tStr) <= 1 Then GoTo ErrorHandler
tW = Val(tStr)
Case vbNo
tFExt = "png"
tStr = InputBox("그림의 폭을 지정하세요.", "그림 크기 지정", tW)
If StrPtr(tStr) = 0 Or Val(tStr) <= 1 Then GoTo ErrorHandler
tW = Val(tStr)
Case vbNo
'EMF 파일은 별도로 벡터 방식이라 특별히 해상도를 입력받을 필요는 없습니다.
tFExt = "emf"
Case vbCancel
GoTo ErrorHandler
End Select
tFExt = "emf"
Case vbCancel
GoTo ErrorHandler
End Select
'폭이 지정되면, 화면 가로/세로 비율에 따라 높이는 자동 지정합니다.
tH = tW * ActivePresentation.PageSetup.SlideHeight / ActivePresentation.PageSetup.SlideWidth
tH = tW * ActivePresentation.PageSetup.SlideHeight / ActivePresentation.PageSetup.SlideWidth
'그림을 파일로 저장할지, 현재 슬라이드에 개체로 삽입할지 선택합니다. 출력된 파일을 바로 사용할 경우라면 슬라이드에 삽입해두면 파일 탐색기로 열어 볼 필요가 없이 그림을 바로 확인할 수 있습니다.
tMSG = MsgBox("선택된 슬라이드를 그림 파일로 저장하시겠습니까?" & vbCrLf & " -Yes : 그림 파일로 저장" & vbCrLf & " -No : 현재 슬라이드에 그림으로 삽입" & vbCrLf & " -Cancel : 작업 취소", vbYesNoCancel, "출력 선택")
If tMSG = vbCancel Then GoTo ErrorHandler
If tMSG = vbYes Then
tMSG = MsgBox("선택된 슬라이드를 그림 파일로 저장하시겠습니까?" & vbCrLf & " -Yes : 그림 파일로 저장" & vbCrLf & " -No : 현재 슬라이드에 그림으로 삽입" & vbCrLf & " -Cancel : 작업 취소", vbYesNoCancel, "출력 선택")
If tMSG = vbCancel Then GoTo ErrorHandler
If tMSG = vbYes Then
'그림으로 저장하는 경우, 저장할 폴더를 선택하도록 합니다.
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
tFN = .SelectedItems(1)
End With
Else
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
tFN = .SelectedItems(1)
End With
Else
'슬라이드에 그림으로 출력하려면 임시 폴더를 출력 폴더로 설정합니다.
tFN = tFSO.GetSpecialFolder(2).Path
End If
If Right(tFN, 1) <> "\" Then tFN = tFN & "\"
tFN = tFSO.GetSpecialFolder(2).Path
End If
If Right(tFN, 1) <> "\" Then tFN = tFN & "\"
'선택된 슬라이드을 전달받습니다.
Set tSlide = ActiveSlide
Set tSlideRange = ActiveWindow.Selection.SlideRange
ReDim tPic(1 To tSlideRange.Count)
Set tSlide = ActiveSlide
Set tSlideRange = ActiveWindow.Selection.SlideRange
ReDim tPic(1 To tSlideRange.Count)
'여러개의 슬라이드가 선택되었다면, 각 슬라이드를 선택폴더에 그림파일로 출력합니다. 만약 중복된 파일명이 있다면 덮어씌우지 않고, 숫자를 붙여 이름을 파일명을 계속 바꿔줍니다.
For i = 1 To tSlideRange.Count
tStr = tFN & "Slide_" & tSlideRange(i).SlideNumber
If tFSO.FileExists(tStr & "." & tFExt) Then
j = 0
Do
j = j + 1
Loop Until Not tFSO.FileExists(tStr & "_" & j & "." & tFExt)
tStr = tStr & "_" & j
End If
tPic(i) = tStr & "." & tFExt
tSlideRange(i).Export tPic(i), tFExt, tW, tH
Next
For i = 1 To tSlideRange.Count
tStr = tFN & "Slide_" & tSlideRange(i).SlideNumber
If tFSO.FileExists(tStr & "." & tFExt) Then
j = 0
Do
j = j + 1
Loop Until Not tFSO.FileExists(tStr & "_" & j & "." & tFExt)
tStr = tStr & "_" & j
End If
tPic(i) = tStr & "." & tFExt
tSlideRange(i).Export tPic(i), tFExt, tW, tH
Next
'슬라이드에 개체로 삽입하도록 했다면, 일단 저장된 파일을 다시 슬라이드로 불러옵니다. 슬라이드를 복사하여 선택하여 붙여넣기 기능으로 슬라이드를 그림으로 변환하는 경우, 해상도를 임의로 변경하기 어렵습니다. 일단 해상도를 조절하여 그림파일로 출력한 후, 다시 powerpoint로 불러오는 방식으로 그림을 삽입합니다. 삽입된 슬라이드 그림은 5%씩 위치를 이동시켜 cascade 형태로 배열한 후 삽입된 전체 그림을 선택한 매크로를 상태로 종료합니다.
If tMSG = vbNo Then
tSlide.Select
Redim tSh(1 to tSlideRange.Count)
For i = 1 To tSlideRange.Count
Set tSh(i) = tSlide.Shapes.AddPicture(tPic(i), msoFalse, msoTrue, ActivePresentation.PageSetup.SlideWidth * 0.05 * i, ActivePresentation.PageSetup.SlideHeight * 0.05 * i)
Next
For i = 1 To tSlideRange.Count
Set tSh(i) = tSlide.Shapes.AddPicture(tPic(i), msoFalse, msoTrue, ActivePresentation.PageSetup.SlideWidth * 0.05 * i, ActivePresentation.PageSetup.SlideHeight * 0.05 * i)
Next
GetShapeRange(tSlide, tSh).Select msoTrue
End If
ErrorHandler:
End Sub
End If
ErrorHandler:
End Sub