PowerPoint 매크로 - 도형, 그림을 그룹 또는 개체별로 형식 변환하기

Powerpoint에서는 여러 개의 그림이나 도형을 선택한 후, '복사 → 선택하여 붙여넣기'를 실행할 때, 선택된 전체 도형이 1개의 그림으로 변환됩니다.

만약, 여러 개의 도형이나 그림의 형태를 각 개체별로 따로 변환하고 싶다면, 각 개체를 선택하여 '복사'한 후 '선택하여 붙여넣기'를 반복해서 실행해야합니다.

그림의 형식에 따라서도 형식을 변환할 필요가 있습니다. PNG 파일의 경우, 작은 용량인 경우에는 큰 무리가 없지만, 무손실 파일 서식이다보니 크기가 커질수록 JPG 형식보다도 저장 용량이 커집니다. 또한, 그림의 밝기나 명암을 조절한 후 저장하게 되면, 저장 용량이 몇배씩 커지는 것을 확인할 수 있습니다. (예를 들어, 1MB짜리 사진을 10장 삽입한 후 저장하면 약 10MB이지만, powerpoint의 명암, 밝기 조절 기능으로 변경한 후 저장하게 되면 50MB 정도로 증가합니다. 저장하는 원리가 어떻게 되는지 모르지만, 단순히 원본에 명암, 밝기 조절 정보만 추가하는 것이 아니라, 변환된 사진을 통째로 저장하는 것 같습니다.)

또한 슬라이드에 도형을 조합하여 복잡한 도형을 삽입했다고 하면, 이들을 그룹화하여 1개의 개체로 만들 수도 있지만, 개체수가 많을수록 로딩할 때 느려집니다. 이럴 때에는 EMF 또는 WMF 파일 형식으로 변환하게 되면, 확대를 해서 보더라도 해상도가 떨어지지 않으면서도 로딩하는 속도가 훨씬 빨라지고, 차후에 다른 사람들이 임의로 편집하는 것을 막을 수 있기 때문에 그리기 개체를 일부로 EMF 형식으로 변환하는 기능을 자주 사용합니다.

이상과 같이, 각각의 개체를 각각의 그림으로 변환하는 기능이 필요하다면 아래와 같은 매크로를 활용할 수 있습니다.

'---------------------------------------
  'mm 단위를 Point 단위로 변환해주기 위한 상수를 정의합니다. 꼭 필요한 선언은 아니지만, powerpoint에서 단위 변환을 위해서 자주 사용될 상수입니다.

Public Const mm2P = 2.83464566928955

'---------------------------------------
Function Convert2Pic(iSh As Shape, iFormat As PpPasteDataType, Optional iOffsetX As Single = 5 * mm2P, Optional iOffsetY As Single = 5 * mm2P) As Shape
  '단일 Shape과 변환할 형식이 입력되면, 복사 및 선택하여 붙여넣기 방법으로 그림 형식을 변환하는 함수입니다.

  Dim tSh As Shape, tStart As Single, tWait As Single, tPos As typePicPos, tH As Single, tW As Single

  'JPG, PNG 파일과 같은 사진 파일이라면, 복사/붙여넣기 과정에서 원본 파일보다 해상도가 저하되는 문제가 있습니다. 특히 powerpoint에 삽입한 후 사이즈를 줄였다고 하면 사진을 다시 확대했을 때 화질 열화가 발생합니다. 일부러 파일의 저장 용량을 줄일 목적이 아니라면, 최대한 원본 해상도를 유지하면서 변환하도록 합니다.

  '만약 입력된 Shape이 JPG, PNG 등의 그림 형식이라면, 그림을 원래 크기로 복원한 후, 복사-선택하여 붙여넣기를 하고, 크기를 원래 상태로 되돌립니다.
  If iSh.Type = msoPicture Then
    With iSh
      tAR = .LockAspectRatio
      tH = .Height
      tW = .Width
      .LockAspectRatio = msoFalse

  '사진의 배율을 변경하기 위해서는 ScaleHeight, ScaleWidth를 사용합니다.
      .ScaleHeight 1, msoTrue, msoScaleFromTopLeft
      .ScaleWidth 1, msoTrue, msoScaleFromTopLeft
      .Copy
      .Height = tH
      .Width = tW
      .LockAspectRatio = tAR
    End With

  '입력된 형식으로 선택하여 붙여넣기를 실행한 후, 위치를 원본과 인접한 곳에 위치시켜줍니다. 기본값은 가로, 세로 5mm 떨어진 위치입니다.

    Set tSh = ActiveSlide.Shapes.PasteSpecial(iType).Item(1)
    tPos = GetPositionOfRotatedShape(iSh)
    With tSh
      .Width = tPos.Width
      .Height = tPos.Height
      .Left = tPos.Left + iOffsetX
      .Top = tPos.Top + iOffsetY
      .LockAspectRatio = msoTrue
    End With
  Else

  '입력된 Shape이 그림이나 사진이 아니라, 그리기 도구로 생성했거나, 그룹화된 개체인 경우, 배율 조정없이 그대로 복사-선택하여 붙여넣기를 실행합니다. 변환된 그림의 Left, Top 속성을 굳이 아래와 같이 만든 이유는 그림의 중심점을 기준으로 위치를 맞추기 위한 것이며, 회전된 그림을 변환하는 경우, 붙여넣는 위치가 조금씩 어긋나는 것을 방지해줍니다.
    iSh.Copy
    Set tSh = ActiveSlide.Shapes.PasteSpecial(iType).Item(1)
    With tSh
      .Left = iSh.Left + iSh.Width / 2 - .Width / 2 + iOffsetX
      .Top = iSh.Top + iSh.Height/ 2 - .Height/ 2 + iOffsetY

      .LockAspectRatio = msoTrue
    End With
  End If

  '선택하여 붙여넣기를 반복할 때, 다음 실행할 때까지 약간의 시간이 필요합니다. 만약, 현재 함수를 반복해서 실행하게 되면, 일부 사진이 제대로 변환되지 않고 오류가 발생됩니다. 따라서, 붙여넣기 작업을 실행한 후, 일정한 시간동안 딜레이를 줍니다. 0.1초보다 작은 값이어도 되지만, 몇십장 정도라고 해도 몇초 정도의 추가 딜레이가 있으므로 일반적인 작업에서는 큰 무리는 없을 것입니다.
  tWait = 0.1: tStart = Timer
  While Timer < tStart + tWait: DoEvents: Wend
  Set Convert2Pic = tSh
End Function
'---------------------------------------
Sub ConvertShape2Pic()
  On Error GoTo ErrorHandler

  '현재 슬라이드에서 선택된 개체를 사진으로 변환하는 Sub 프로시저입니다.
  Dim tSlide As Slide, tSR As ShapeRange, tStr As String, tFormatNum As Long, tSh() As Shape, i As Long, tFormat As PpPasteDataType, tMSG, tCheck As Boolean

  '현재 슬라이드와 선택된 Shape 개체를 확인하고, 그림이 선택된 것이 없다면 종료합니다. 
  Set tSlide = ActiveSlide
  Set tSR = ActiveWindow.Selection.ShapeRange
  If tSR Is Nothing Then GoTo ErrorHandler

  '변환할 그림형식을 입력받도록 합니다. 개인이 많이 사용하는 형식으로 선별해서 지정해두면 되고, 1가지 형식 밖에 쓰지 않는다면, 굳이 확인창이 필요없이 형식을 지정하면 됩니다.
  tStr = InputBox("변환할 그림형식을 선택하세요." & vbCrLf & " 1 : EMF (메타파일)" & vbCrLf & " 2 : JPG (저용량)" & vbCrLf & " 3 : PNG (무손실, 고용량)", "그림형식 선택", 2)
  tFormatNum = Round(Val(tStr), 0)
  If StrPtr(tStr) = 0 Or tFormatNum < 1 Or tFormatNum > 3 Then GoTo ErrorHandler  

  Select Case tFormatNum
    Case 1
      tFormat = ppPasteEnhancedMetafile
    Case 2
      tFormat = ppPasteJPG
    Case 3
      tFormat = ppPastePNG
  End Select
  

  '선택된 Shape의 갯수가 1개라면 1개의 그림으로 변환하면 되지만, Shape의 갯수가 2개 이상이라면, 각각의 그림으로 변환할지, 전체를 1개의 그림으로 변환할지 선택하도록 합니다.
  If tSR.Count > 1 Then
    tMSG = MsgBox("선택된 전체 그림을 1개의 그림파일로 변환하시겠습니까?" & vbCrLf & " -Yes : 1개 그림으로 변환" & vbCrLf & " -No : 그룹별 각각 그림으로 변환" & vbCrLf & " -Cancel : 작업 취소", vbYesNoCancel, "출력 선택")
  Else
    tMSG = vbNo
  End If
  

  Select Case tMSG

  '선택된 전체 개체를 1개의 그림으로 붙여넣는 경우에는 단순히 복사, 선택하여 붙여넣기를 실행합니다.

    Case vbYes

      tSR.Copy

      ActiveSlide.Shapes.PasteSpecial(tType).Select msoTrue

  '각각의 개체마다 나눠서 그림으로 변환할 경우에는 그림 변환 함수를 실행하고, 변환된 사진을 선택한 상태로 매크로를 종료시킵니다.

    Case vbNo
      ReDim tSh(1 To tSR.Count)
      For i = 1 To tSR.Count
        Set tSh(i) = Convert2Pic(tSR(i), tFormat)
      Next
      GetShapeRange(tSlide, tSh).Select msoTrue
    Case vbCancel
      GoTo ErrorHandler
  End Select
ErrorHandler:
  Erase tSh
End Sub