보통 분할 인쇄라고 하면 한 페이지에 여러 장을 인쇄하는 것을 말하지만 여기서는 PPT로 이미지 확대 인쇄하는 방법을 알아봅니다.
최근에는 프린터기의 발달로 인쇄 설정에서 확대 인쇄가 가능한 기종도 있는 것 같은데요, 아무리 찾아봐도 사용하고 있는 인쇄 설정에서는 확대하는 방법이 없습니다. 아니면 PPT 프로그램이 지원하지 않는 것인지 어디가 문제인지 모르지만 인쇄에서 지원하지 않는 이미지 확대 방법을 알아봅니다.
이미지 분할 인쇄는 이미지를 확대 인쇄할 수 없는 상황일 때, 즉 A4만 인쇄가 되는 프리터기에서 더 큰 이미지를 인쇄하는 것을 말합니다. 이미지를 쪼개서 4장, 9장, 16장으로 인쇄를 하는 방법이죠.
PPT에 이미지를 넣었습니다. 키보드 Alt + F8 키를 눌러 매크로 창을 띄우고 Slice로 매크로 이름을 넣고 엔터 합니다.
매크로 작업 창에 아래 소스를 그대로 몽땅 넣고 창을 닫습니다.
Option Explicit
Dim TargetSlide As Integer
Dim TargetFile As String
Sub Slice()
Dim user As String
Dim RowCol() As String
Dim Cols As Integer, Rows As Integer
If Not ActivePresentation.Saved Then MsgBox "반드시 파일이 먼저 저장된 상태여야 합니다.": Exit Sub
user = InputBox("선택 슬라이드를 가로, 세로로 작게 분할하여 EMF파일로 저장합니다." & vbNewLine & vbNewLine & _
"가로와 세로 칸수를 콤마(,)로 구분해서 입력하세요:" & vbNewLine & "(예: 3, 2 =>가로3칸*세로2칸)", "화면 분할 저장")
If Len(user) = 0 Then Exit Sub
RowCol = Split(user, ",")
If UBound(RowCol) <> 1 Then MsgBox "콤마로 구분된 숫자2개가 아닙니다.": Exit Sub
If Not IsNumeric(RowCol(0)) Or Not IsNumeric(RowCol(1)) Then _
MsgBox "숫자로 입력하세요.": Exit Sub
Cols = CInt(RowCol(0)): Rows = CInt(RowCol(1))
TargetSlide = ActiveWindow.Selection.SlideRange(1).SlideIndex ' 선택된 첫번째 슬라이드
'CenterImage ' 중앙정렬
TargetFile = ActivePresentation.Path & "\" & TargetSlide & ".emf"
SaveSlide
SliceImage Cols, Rows '가로 세로 숫자를 변경 가능: 3,3 이나 2,4 등
Save2PPTx Cols, Rows
End Sub
Function CenterImage()
Dim SW As Single, SH As Single
Dim shp As Shape
Dim Margin As Single
Margin = 5 '바깥여백
With ActivePresentation.PageSetup
SW = .SlideWidth
SH = .SlideHeight
End With
'도형 개수가 1개이고 그림형식이면 가운데로 맞춤
With ActivePresentation.Slides(TargetSlide)
If .Shapes.Count = 1 And .Shapes(1).Type = msoPicture Then
Set shp = .Shapes(1)
shp.LockAspectRatio = msoFalse
shp.Width = SW - Margin * 2
shp.Height = SH - Margin * 2
shp.Left = Margin
shp.Top = Margin
End If
End With
End Function
Function SaveSlide()
With ActivePresentation
.Slides(TargetSlide).Export TargetFile, "EMF", 1, 1
End With
End Function
Function SliceImage(Col As Integer, Row As Integer)
On Error Resume Next
Dim n As Integer
Dim r As Integer, c As Integer
Dim w As Single, h As Single
Dim oWidth As Single, oHeight As Single
With ActivePresentation.PageSetup
oWidth = .SlideWidth: oHeight = .SlideHeight
End With
w = oWidth / Col: h = oHeight / Row
For r = 0 To Row - 1
For c = 0 To Col - 1
With ActivePresentation.Slides(TargetSlide).Shapes.AddPicture(TargetFile, _
0, 1, 0, 0, oWidth, oHeight)
.Name = "Slice" & TargetSlide & "_" & (r + 1) & "_" & (c + 1)
.ScaleWidth 1, msoTrue
.ScaleHeight 1, msoTrue
.PictureFormat.CropLeft = oWidth * c / Col
.PictureFormat.CropRight = oWidth * (Col - c - 1) / Col
.PictureFormat.CropTop = oHeight * r / Row
.PictureFormat.CropBottom = oHeight * (Row - r - 1) / Row
.Width = w
.Height = h
.Left = 0 + c * w
.Top = 0 + r * h
.Line.Weight = 0.1
.Export ActivePresentation.Path & "\" & .Name & ".emf", ppShapeFormatEMF, 1, 1
.Delete
End With
Next c
Next r
End Function
Function Save2PPTx(Col As Integer, Row As Integer)
Dim usr As VbMsgBoxResult
Dim ppt As Presentation
Dim sld As Slide
Dim shp As Shape
Dim SW As Single, SH As Single
Dim pptFile As String, slicedFile As String
Dim r As Integer, c As Integer
Dim Margin As Single
Set ppt = ActivePresentation
If ppt.Slides.Count > 1 Then
usr = MsgBox("_Sliced.pptx파일의 슬라이드 개수가 이미 2개 이상입니다. 계속할까요?" & vbNewLine & vbNewLine & _
"=> 계속 추가(Yes), 새로 시작(No), 취소(Cancel)", vbYesNoCancel)
If usr = vbNo Then
For c = ppt.Slides.Count To 2 Step -1
ppt.Slides(c).Delete
Next c
ElseIf usr = vbCancel Then
Set ppt = Nothing: Exit Function
End If
End If
With ppt.PageSetup
SW = .SlideWidth: SH = .SlideHeight
End With
Margin = 0 '슬라이드 여백
For r = 1 To Row
For c = 1 To Col
Debug.Print r, c;
ppt.Slides.Add((r - 1) * c + c, ppLayoutBlank).MoveTo ppt.Slides.Count + 1
Set sld = ppt.Slides(ppt.Slides.Count)
slicedFile = "Slice" & TargetSlide & "_" & r & "_" & c & ".emf"
Set shp = sld.Shapes.AddPicture( _
ActivePresentation.Path & "\" & slicedFile, 0, 1, Margin, Margin)
shp.Name = slicedFile
shp.LockAspectRatio = msoFalse
shp.Width = SW
shp.Height = SH
Debug.Print slicedFile
Kill ActivePresentation.Path & "\" & slicedFile
Next c
Next r
'ppt.Close
Set ppt = Nothing
MsgBox "Sliced images are saved in pptx."
End Function
다시 한번 더 Alt + F8을 눌러 매크로를 띄우고 실행을 누릅니다.
먼저 파일부터 저장하라고 하네요.
파일 형식은 매크로 사용 프레젠테이션으로 저장합니다.
Alt + F8을 눌러 매크로 창을 띄우고 실행을 누릅니다.
화면 분할은 몇 장으로 나눌 것인지 정합니다.
간단하게 보여드리기 위해 4장으로 나누었습니다.
슬라이드에 원본 1장과 4장으로 나누어져 생성되었습니다. 각 슬라이드를 인쇄해서 합쳐야 하는 과정이 남아있습니다.
슬라이드로 생성된 이미지 4장을 모아봤습니다.
인쇄는 프린터기의 여백이 따로 정해져 있기 때문에 실제 프린트를 하면 원본이 잘려 나올지 어떨지는 모르겠습니다.
매크로 소스 중에 여백이 설정된 부분이 있는데요,
Margin = 0 '슬라이드 여백
이곳을 수정하면 어떨지 모르겠습니다.
사실 매크로는 알려드릴 만큼의 지식이 없으니 자세히 말씀드리기가 어렵네요.
여러 장으로 출력된 이미지를 하나로 오려 붙여야 하는 번거로움은 있지만 해상도가 높은 이미지를 사용한다면 이미지 깨짐 없이 확대 사용할 수 있겠습니다.
P.S
뒤에 알았습니다. 이 소스의 원천은 개발 사이트에서 가져온 것입니다.
또 다른 많은 공을 들인 개발 소스가 있는데, 이 글을 지우는 것이 옳겠지만,
출처를 표시하며 미안한 마음을 대신합니다.
https://konahn.tistory.com/entry/slice