파워포인트 차트를 EMF로 저장했다가 다시 삽입 후

우클릭하고 오피스 도형으로 변환해도

축이나 제목 등의 글자가 있는 부분은 여전히 변경 가능한 텍스트박스상태로 남아있습니다.

나중에 편집이 가능한 점은 있지만

폰트가 없으면 다른 폰트로 보이게 되고

확대 축소 등의 사이즈를 변경할 때 폰트 크기가 변경이 안되어 불편하기도 합니다.

 

텍스트 박스를 순수한 자유형도형으로 변환할 수 있습니다. 텍스트박스나 글자가 있는 도형은

2013이후 도입된 기능인 도형병합(빼기)를 이용하면 점편집이 가능한 순수한 자유형도형으로 변환됩니다.

도형병합으로 처리하는 방법은 바로 해당 텍스트 도형에서 아무 빈 도형을 빼주면 됩니다.

 

이 방법을 이용해서 차트 > EMF 로 저장하여 도형으로 변환해서 그룹을 해제하고 내부 텍스트 도형들을

일괄로 순수 자유형 도형으로 변환해주는 VBA입니다.

 

 

 

더보기
Option Explicit
Const NewSlide As Boolean = False 'False이면 현재 슬라이드에 만들고 True 이면 새슬라이드에 만듬
Sub Chart2Shapes()
Dim sld As Slide
Dim shp As Shape, tshp As Shape
Dim target As String
Dim l!, t!, w!, h!, cname$
On Error Resume Next
Set shp = ActiveWindow.Selection.ShapeRange(1)
On Error GoTo 0
If shp Is Nothing Then MsgBox "차트를 선택하세요.": Exit Sub
If shp.Type <> msoChart Then MsgBox "차트를 선택하세요.": Exit Sub
'기존 차트 위치와 크기 기억
With shp
l = .Left: t = .Top: w = .Width: h = .Height
cname = .Name
End With
'차트 emf 그림으로 저장
target = ActivePresentation.Path & "\" & cname & ".emf"
shp.Export target, ppShapeFormatEMF
Set sld = shp.Parent
Set sld = ActivePresentation.Slides.Add(sld.SlideIndex + 1, ppLayoutBlank)
DoEvents
sld.Select
'emf 그림을 다시 삽입
Set shp = sld.Shapes.AddPicture(target, msoFalse, msoTrue, l, t, w, h)
DoEvents
Kill target
shp.Select
'도형개체로 변환 -> 확인 클릭 필요 'Call CommandBars.ExecuteMso("SVGEdit")
Call CommandBars.ExecuteMso("PictureEdit")
myWait 1
SendKeys "{ENTER}" '효과 없음
myWait 1
'그룹 해제
Set shp = sld.Shapes(sld.Shapes.Count)
shp.Ungroup
myWait 1
'도형 변환 취소 확인
If sld.Shapes.Count = 1 Then MsgBox "도형변환 취소됨": Exit Sub
'필요 없는 AutoShape 삭제
For l = sld.Shapes.Count To 1 Step -1
If sld.Shapes(l).Name Like "AutoShape *" Then sld.Shapes(l).Delete
Next l
myWait 1
'차트 내부에서 텍스트가 있는 경우 빈 도형과 도형병합(빼기)를 이용해서 Freeform으로 변환(2013dltkd)
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
'빈 도형 추가
Set tshp = sld.Shapes.AddShape(msoShapeRectangle, 0, -10, 1, 1)
tshp.Line.Visible = msoFalse
shp.Select msoTrue
tshp.Select msoFalse
'빈 도형과 도형병합(빼기)
ActiveWindow.Selection.ShapeRange.MergeShapes msoMergeSubtract
'Call CommandBars.ExecuteMso("ShapesSubtract")
DoEvents ' myWait 0.1
End If
End If
Next shp
'모두 선택후 그룹으로 묶기
sld.Shapes.SelectAll
Set shp = ActiveWindow.Selection.ShapeRange.Group
shp.Name = cname
If NewSlide Then Exit Sub
'원래 슬라이드로 복사
shp.Copy
With ActivePresentation.Slides(sld.SlideIndex - 1)
.Shapes(cname).Visible = msoFalse
.Shapes.Paste (1)
End With
DoEvents
sld.Delete
End Sub
Function myWait(t As Double)
Dim tick As Double
tick = Timer
While Timer - tick < t: DoEvents: Wend
End Function

 

중간에 간혹 에러가 날 수 있습니다.

개체가 많아서 작업시간이 더 걸릴 수도 있습니다.

차트도 원형, 막대, 선 등 기본 차트인 경우 잘 되고

최신 차트 형태는 변환해도 비트맵 그림인 경우가 많습니다.

 

샘플 파일 첨부합니다.

Chart2Shapes1.pptm
0.11MB