Sub ungroupEMF()
Dim oshp As Shape
Dim oshpR As ShapeRange
Dim osld As Slide
On Error Resume Next
If ActiveWindow.Selection.Type <> ppSelectionShapes Then Exit Sub
Set osld = ActiveWindow.View.Slide
Set oshp = ActiveWindow.Selection.ShapeRange(1)
oshp.Copy
osld.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Select
With ActiveWindow.Selection.ShapeRange
.Left = oshp.Left
.Top = oshp.Top
oshp.Delete
.Ungroup.Select
.Ungroup.Select
End With
End Sub