将EMF/EPS图片文件解组到Excel VBA中的Microsoft Office图形对象

我有一些VBA代码，可以将EPS图片插入PowerPoint幻灯片，如下所示：

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

Excel的等效插入图片功能如下：

ActiveSheet.Pictures.Insert(filename).Select

或者，如果需要对对象进行引用：

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

但当我尝试用下面的行将其解组时，我得到一个错误438“Object不支持此属性或方法”

但是，如果在正确插入图纸的图片上单击鼠标右键，则在确认转换为Microsoft Office图形对象后，可以成功将其解组

为什么用户界面允许解组，而Excel VBA不允许（而PowerPoint VBA允许），有没有办法解决这个问题？

只是猜测

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

---

一次，将对象解组并保持选中状态，将b/g对象和组中的其他对象留给您；然后再次取消对其组件的编组并使其处于选中状态：

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

在几个不同的简单EPS导入和EMF/WMF上进行了测试；和他们一起工作

---

但要明白，办公室处理EPS的方式有点像堕胎；一直都是。至少这一次，他们做错事的原因通常是正确的。

我不熟悉如何处理EPS形状，但我猜Excel会将其视为OLE对象。是否可以调试和检查要在Excel中解组的形状类型？如果只想取消分组形状，则形状类型应为msoGroup。好的，再播放一段时间后，我可以通过创建PowerPoint实例、创建新演示文稿、添加幻灯片、插入EPS图片、取消分组、将转换后的图形对象复制到剪贴板并将其粘贴到excel来实现，它在选择窗格中显示为一组形状。但这一切都需要大量时间，而且非常笨重。我上传了一个我在这里使用的示例EPS文件：如果我将此文件插入PowerPoint幻灯片并使用activewindow.selection.ungroup，它会起作用，但Excel的情况并非如此，我会收到错误“对象不支持此属性或方法”。奇怪的有人会认为，两个MSO应用程序在处理此类媒体内容时会使用相同的机制！对于类型，我得到2（ppselectionshapes）在PowerPoint中，但与上面Excel中的错误相同。Excel似乎不喜欢EPS文件，但为什么在通过UI将同一EPS文件插入工作表时，仍然可以手动将其解组？这看起来很有效，谢谢Steve:-）我目前正在Word中尝试相同的方法，但由于InlineShapes和Shapes图层！设置oShp=App.ActiveDocument.Shapes.AddPicture（文件名，false，true，0,0,50,50）oShp.Select Selection.shaperage.Ungroup.Select“错误5”

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