PowerPoint 매크로 - 메타파일 형식 그림을 그리기(Shape) 형식으로 바꾸기

Powerpoint에서 제공하는 그리기 도구를 이용해서 그림을 그린 후, 개체가 많은 경우 그룹화하는 것보다는 메타파일로 변환해두면, 개체수가 많아질수록 로딩속도가 빠르고, 실수로 편집하다 그림이 변형되는 것을 막을 수 있어서 자주 사용합니다.

한편으로는 엑셀이나 다른 프로그램으로부터 메타파일 형태로 붙여넣기를 한 후, Powerpoint에서 그림을 수정해야하는 경우가 종종 있습니다. 글자만 약간 조정한다거나, 불필요한 부분을 삭제하거나 혹은 선을 추가한다거나... 

Powerpoint는 메타파일을 선택한 후 그룹해제를 하게 되면 그리기(shape)로 변환시켜주는 기능이 있습니다만, 이때 메타파일에는 그리기 개체에는 없던 프레임이 삽입되면서 투명한 개체수가 늘어납니다. 만약 약간 엑셀 차트와 같이 약간 복잡한 구조의 메타파일이라면 불필요한 투명 프레임이 많아서 수정하려는 개체를 선택하려고 해도 엉뚱한 개체를 선택하는 상황이 종종 발생합니다.

메타파일을 그리기 개체로 변환한 후, 불필요한 투명개체나 프레임을 제거해주면 편집 작업하는 과정에서 조금은 불편함이 줄어들 수 있습니다. 아래의 매크로는 메타파일을 그리기 개체로 변환해주고, 투명 프레임을 제거해주는 함수입니다. 만약 사용자가 자주 사용하는 개체의 특징을 잡아 불필요하다고 판단되는 개체의 조건을 추가해줄 수 있습니다.

'------------------------------------------
  '변환할 개체와 원본을 삭제할지 여부, 변환된 결과물을 출력할 위치를 입력받습니다.

Function ConvertEMF2Shape(iSh As Shape, Optional iDelOrigin As Boolean = False, Optional iOffsetX As Single = 0, Optional iOffsetY As Single = 0) As Shape
  On Error GoTo ErrorHandler
  Dim tSR As ShapeRange, tSh As Shape, tSh2 As Shape, tShDel() As Shape, tShSub() As Shape, tDel As Boolean, m As Long, n As Long, i As Long

  '만약 개체가 그림 형식이 아니면 함수를 종료합니다.
  If Not (iSh.Type = msoPicture) Then GoTo ErrorHandler
  '원본(emf)을 복사한 후, Ungroup을 하게 되면 그리기 개체로 변환된 후 그룹화되어 있습니다. 1번더 Ungroup을 하게 되면 그룹이 해제된 그리기 개체로 분리된 ShapeRange를 반환합니다. Duplicate를 실행할 때에도 Shape 변수에 저장하기 위해서는 아이템 인덱스를 붙여주어야 합니다.

  Set tSh = iSh.Duplicate(1)

  Set tSh2 = tSh.Ungroup(1)

  Set tSR = tSh2.Ungroup

  '만약, 그룹해제된 ShapeRange가 비어있다면 함수를 종료하고, 1개 이상의 개체가 포함되어있다면, 텍스트가 포함되지 않은 투명한 개체를 삭제하도록 합니다.

  '삭제하지 않은 나머지 그리기 개체는 그룹화하여 반환합니다.

  If tSR Is Nothing Then tSR.Delete: GoTo ErrorHandler

  If tSR.Count >= 1 Then

    n = 0: m = 0

    For i = 1 To tSR.Count

      tDel = False

      If Not(tSR(i).Line.Visible = msoTrue Or tSR(i).Fill.Visible = msoTrue) Then

        If tSR(i).HasTextFrame = msoTrue Then

          If Trim(tSR(i).TextFrame2.TextRange.Text) = "" Then tDel = True

        End if

      End If

      If tDel Then

        n = n + 1

        ReDim Preserve tShDel(1 To n)

        Set tShDel(n) = tSR(i)

      Else

        m = m + 1

        ReDim Preserve tShSub(1 To m)

        Set tShSub(m) = tSR(i)

      End If

    Next

    For i = 1 To n: tShDel(i).Delete: Next

    If m = 0 Then

      Set tSh2 = Nothing

    ElseIf m = 1 Then

      Set tSh2 = tShSub(1)

    Else

      Set tSh2 = GetShapeRange(ActiveSlide, tShSub).Group

    End If

  Else

    tSh.Delete

  End If

  '원본을 삭제하도록 했다면, 원본을 삭제합니다.

  If iDelOrigin Then iSh.Delete

  Set ConvertEMF2Shape= tSh2

  Erase tShSub, tShDel

  Exit Function

ErrorHandler:

  Set ConvertEMF2Shape= iSh

  Erase tShSub, tShDel

End Function