Разгруппировать файл изображения EMF/EPS в объект рисования Microsoft Office в Excel VBA

У меня есть код 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 «Объект не поддерживает это свойство или метод».

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

Однако, если я щелкну правой кнопкой мыши изображение, которое было правильно вставлено на лист, я смогу успешно разгруппировать его после подтверждения преобразования в объект рисования Microsoft Office.

Почему пользовательский интерфейс позволяет разгруппировать, а Excel VBA — нет (в то время как PowerPoint VBA — делает), и есть ли способ обойти это?


excel vba .emf
person Jamie Garroch - MVP    schedule 02.10.2013    source источник
comment
Я не знаком с тем, как обрабатываются формы EPS, но я предполагаю, что Excel рассматривает их как объект OLE. Можете ли вы отладить и проверить тип фигуры, которую вы пытаетесь разгруппировать в Excel? Если вы хотите разгруппировать только сгруппированные фигуры, тип фигуры должен быть msoGroup.   -  person Aaron Thomas    schedule 02.10.2013
comment
Хорошо, еще немного поиграв, я могу заставить его работать, создав экземпляр PowerPoint, создав новую презентацию, добавив слайд, вставив изображение EPS, разгруппировав его, скопировав преобразованный объект рисунка в буфер обмена и вставив его в excel, где он отображается в виде группы фигур на панели выбора.   -  person Jamie Garroch - MVP    schedule 03.10.2013
comment
Но все это занимает огромное количество времени и очень неуклюже. Я загрузил пример файла EPS, который использую здесь: i-present .co.uk/stackoverflow/b1-034-034_telephone.eps Если я вставлю это в слайд PowerPoint и использую activewindow.selection.ungroup, это сработает, но то же самое не верно для Excel, для которого я получаю сообщение об ошибке Объект не поддерживает это свойство или метод. Странный. Можно было бы подумать, что два приложения MSO будут использовать один и тот же механизм при обработке этого типа медиа-контента! И для типа я получаю 2 (ppselectionshapes) в PowerPoint, но ту же ошибку выше для Excel.   -  person Jamie Garroch - MVP    schedule 03.10.2013
comment
Кажется, что Excel просто не любит файлы EPS, но тогда почему все еще возможно вручную разгруппировать один и тот же файл EPS, когда он вставлен через пользовательский интерфейс на лист?   -  person Jamie Garroch - MVP    schedule 03.10.2013

Ответы (2)


arrow_upward
0
arrow_downward

Один раз, чтобы разгруппировать объект и оставить его выделенным, оставив вас с объектом b/g и другими объектами в группе; затем снова разгруппировать его компоненты и оставить их выбранными:

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

Протестировал его на паре разных простых импортов EPS и EMF/WMF; работает со всеми из них.

Поймите, однако, что то, как Office обрабатывает EPS, является чем-то вроде аборта; всегда был. По крайней мере, на этот раз они делают неправильные вещи по в целом правильным причинам.

person Steve Rindsberg    schedule 03.10.2013
comment
Похоже, это работает, спасибо Стиву :-) В настоящее время я пробую то же самое в Word, где все снова отличается из-за слоев InlineShapes и Shapes! set oShp = App.ActiveDocument.Shapes.AddPicture (имя файла, ложь, истина, 0,0,50,50) oShp.Select Selection.ShapeRange.Ungroup.Select 'ошибка 5 - person Jamie Garroch - MVP; 03.10.2013

arrow_upward
0
arrow_downward

Просто предположение!

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
person John Wilson    schedule 03.10.2013