«Ошибка -2147188160 (80048240) Фигуры (неизвестный элемент): неверный запрос.»при попытке конвертировать объекты в изображения в PowerPoint - PullRequest
Новая
       10

«Ошибка -2147188160 (80048240) Фигуры (неизвестный элемент): неверный запрос.»при попытке конвертировать объекты в изображения в PowerPoint

0 голосов
/ 08 февраля 2019

Я новый пользователь stackoverflow, поэтому я не уверен, правильно ли я это делаю, но я пытаюсь опубликовать вопрос о ранее заданном решении от Стива Риндсберга .У меня недостаточно репутации, чтобы комментировать, и, похоже, нет способа отправить сообщение другому пользователю напрямую, поэтому я публикую новый вопрос здесь.

Не могу получитькод ниже, чтобы работать.Я использую PowerPoint O365 версии 1901, и у меня есть два типа фигур, которые я пытаюсь преобразовать, msoChart и msoLinkedOLEObject (некоторые листы Excel).Первоначально я изменил ppPasteEnhancedMetafile на ppPastePNG, потому что я хочу PNG, но он не работает ни с одним из них.

Вот код: 

Sub ConvertAllShapesToPic()
    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            ' modify the following depending on what you want to
            ' convert
            Select Case oSh.Type
                Case msoChart, msoEmbeddedOLEObject, msoLinkedOLEObject
                    ConvertShapeToPic oSh
                Case msoPlaceholder
                    If oSh.PlaceholderFormat.ContainedType = msoEmbeddedOLEObject _
                        Or oSh.PlaceholderFormat.ContainedType = msoLinkedOLEObject _
                        Or oSh.PlaceholderFormat.ContainedType = msoChart _
                        Then
                        ConvertShapeToPic oSh
                    End If
                Case Else

            End Select
        Next
    Next
End Sub

Sub ConvertShapeToPic(ByRef oSh As Shape)
    Dim oNewSh As Shape
    Dim oSl As Slide

    Set oSl = oSh.Parent
    oSh.Copy
    Set oNewSh = oSl.Shapes.PasteSpecial(ppPastePNG)(1)

    With oNewSh
        .Left = oSh.Left
        .Top = oSh.Top
        Do
            .ZOrder (msoSendBackward)
        Loop Until .ZOrderPosition < oSh.ZOrderPosition
    End With

    oSh.Delete

End Sub

Я заметил, что я запускаю ConvertAllShapesToPic из ссылки / действия в SlideРежим показа, он не завершается и не работает тихо.Если я добавляю командную кнопку (элемент управления ActiveX) и запускаю ее оттуда, я получаю следующее:

Ошибка времени выполнения '-2147188160 (80048240)':

Shapes (неизвестный член):Неверный запрос.Указанный тип данных недоступен.

Ошибка при установке. Set oNewSh = sld.Shapes.PasteSpecial (ppPastePNG) (1).После ошибки, если я возвращаюсь к слайду и Ctrl-V, я получаю изображение, поэтому я знаю, что оно работает до этого момента.

Я пробовал различные решения, которые я нашел в Интернете для этого, такие как добавлениеDoEvents или ActiveWindow.Panes (1). Активировать после копирования, но, похоже, это не имеет значения.Есть предложения?

Спасибо

1 Ответ

0 голосов
/ 10 февраля 2019

Я нашел какой-то другой код для преобразования диаграмм, а затем я разрываю ссылки на листах, которые автоматически превращают их в изображения.

Одна вещь, которую я понял, - вы должны выйти из режима слайд-шоу, чтобы разорватьmsoLinkedOLEObject ссылки.Я не уверен на 100%, почему ... но этот код работает для меня: 

Sub DoStuff()

    Call LinkedGraphsToPictures
    ActivePresentation.SlideShowWindow.View.Exit
    Call BreakAllLinks

End Sub


Sub LinkedGraphsToPictures()

    Dim shp As Shape
    Dim sld As Slide
    Dim pic As Shape
    Dim shp_left As Double
    Dim shp_top As Double

    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes

            If shp.Type = msoChart Then
                'Retrieve current positioning
                shp_left = shp.Left
                shp_top = shp.Top

                'Copy/Paste as Picture
                shp.Copy
                DoEvents
                sld.Shapes.PasteSpecial DataType:=ppPastePNG

                Set pic = sld.Shapes(sld.Shapes.Count)

                'Delete Linked Shape
                shp.Delete

                'Reposition newly pasted picture
                pic.Left = shp_left
                pic.Top = shp_top
            End If

        Next shp
    Next sld

End Sub


Sub BreakAllLinks()

    Dim shp As Shape
    Dim sld As Slide

    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            If shp.Type = msoLinkedOLEObject Then
                shp.LinkFormat.BreakLink
            End If
        Next shp
    Next sld

End Sub
...