Question

我是stackoverflow的新用户，所以不确定自己是否做对了，但是我想在previously given solution by Steve Rindsberg上提问。我没有足够的声誉来发表评论，并且似乎没有一种直接向其他用户发送消息的方法，因此我在这里发布了一个新问题。

我似乎无法使下面的代码正常工作。我使用的是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，它不会完成，并且会以静默方式失败。如果添加命令按钮（ActiveX控件）并从那里运行它，则会得到以下信息：

运行时错误'-2147188160（80048240）'：

形状（未知成员）：无效的请求。指定的数据类型不可用。

在Set oNewSh = sld.Shapes.PasteSpecial（ppPastePNG）（1）上失败。错误发生后，如果我回到幻灯片并按Ctrl-V，就可以得到图像，因此我知道它可以正常工作。

我已经尝试过在网上找到的各种解决方案，例如添加DoEvents或ActiveWindow.Panes（1）。在复制后激活，但这似乎没有什么作用。有什么建议吗？

谢谢

Answer 1

我找到了一些其他代码来转换图表，然后中断了工作表上的链接，这些链接自动将它们转换为图像。

我发现的一件事是您必须退出幻灯片显示模式才能断开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

“错误-2147188160（80048240）形状（未知成员）：无效的请求。”尝试将对象转换为PowerPoint中的图像时

1 个答案: