Ungroup an EMF/EPS picture file to a Microsoft Office Drawing Object in Excel VBA

Question

I've got some VBA code which inserts an EPS picture to a PowerPoint slide as follows:

Function InsertPicture(filename as String) As Shape
    Dim curSlide As Integer
    Dim oShp As Shape, gShp As Shape
    curSlide = ActiveWindow.View.Slide.SlideIndex
    With ActivePresentation.Slides(curSlide).Shapes
        Set oShp = .AddPicture(filename, msoFalse, msoTrue, 0, 0)
        ' Convert (by ungrouping) from EPS to Microsoft Office drawing object
        oShp.Ungroup.Name = "GroupEPS"
        ' Return the new Microsoft Office drawing object
        Set InsertPicture = ActivePresentation.Slides(curSlide).Shapes("GroupEPS")
    End With
End Sub

The equivalent insert picture function for Excel is this:

ActiveSheet.Pictures.Insert(filename).Select

Or this if a reference to the object is required:

Dim oPic as Object
Set oPic = ActiveSheet.Pictures.Insert(filename)

But when I try to ungroup it with the following line, I get an error 438 "Object doesn't support this property or method"

' For a selection
Selection.Ungroup
' For an object
oPic.Ungroup.Name = "GroupEPS"

However, if I right click on the picture that was correctly inserted into the sheet I can successfully ungroup it, after confirming the conversion to a Microsoft Office drawing object.

Why does the UI allow ungrouping but Excel VBA doesn't (while PowerPoint VBA does) and is there a way round this?

Answer 1

Once to get the thing ungrouped and leave it selected, leaving you with the b/g object and the other objects in a group; then again to ungroup to its components and leave them selected:

Selection.ShapeRange.Ungroup.Select
Selection.ShapeRange.Ungroup.Select

Tested it on a couple different simple EPS imports and an EMF/WMF; works with all of them.

Understand, though, that the way Office handles EPS is something of an abortion; always has been. At least this time round, they do the wrong thing for generally right reasons.

Answer 2

Just a guess!

Sub unGrp()
Dim opic As ShapeRange
Dim filename As String
filename = "C:\Users\John\Desktop\telephone.eps"
ActiveSheet.Pictures.Insert(filename).Select
Set opic = ActiveWindow.Selection.ShapeRange
opic.Ungroup
End Sub