Vbscript 在Powerpoint 2010中将公式转换为图像的宏

我试图预先准备一个宏，它可以将PowerPoint2010演示文稿中的所有方程式转换为图像，同时保留位置和动画效果/顺序

根据提供的提示（感谢Steve Rindsberg），我对脚本进行了如下修改：

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

    On Error Resume Next

    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 msoTextBox, msoEmbeddedOLEObject, msoLinkedOLEObject
                    ConvertShapeToPic oSh
                Case Else
            End Select
        Next
    Next

NormalExit:
    Exit Sub

ErrorHandler:
    Resume 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(ppPasteEnhancedMetafile)(1)
    oSh.PickupAnimation
    oNewSh.ApplyAnimation
    With oNewSh
        .Left = oSh.Left
        .Top = oSh.Top
        Do
            .ZOrder (msoSendBackward)
        Loop Until .ZOrderPosition = .ZOrderPosition
        .AnimationSettings.AnimationOrder = oSh.AnimationSettings.AnimationOrder
    End With
    oSh.Delete

NormalExit:
    Exit Sub

ErrorHandler:
    Resume Next

End Sub

此脚本的问题：

所有的方程式都没有转换成图像

一些没有方程式的文本框正在丢失其内部动画效果（例如单击时显示第二个项目符号文本）

我准备此脚本的原因是，当我将PowerPoint 2010转换为清晰的演示文稿时，由于清晰的09不完全支持PPT2010公式，因此无法正确呈现公式

我有100多个PPT，几乎所有幻灯片上都有公式。如果没有编程方法，唯一的选择就是手动转换所有方程式并重新应用动画效果

感谢您提供的任何帮助：-）

---

谢谢

关于第一个问题，我的错：

为此：

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 msoTextBox, msoEmbeddedOLEObject, msoLinkedOLEObject
                    ConvertShapeToPic oSh
                Case Else
            End Select
        Next
Next

替换：

Dim x as long 

For x = ActivePresentation.Slides.Count to 1 Step -1
        Set oSl = ActivePresentation.Slides(x)
        For Each oSh In oSl.Shapes
            ' modify the following depending on what you want to
            ' convert
            Select Case oSh.Type
                Case msoTextBox, msoEmbeddedOLEObject, msoLinkedOLEObject
                    ConvertShapeToPic oSh
                Case Else
            End Select
        Next
Next

---

我最初写这篇文章时，可能只测试了每张幻灯片一个等式的幻灯片。当您单步浏览一个集合并可能删除成员时，您需要向后浏览，否则在删除成员时索引会出错。

有关“未转换”问题的可能答案，请参阅下文。但我不确定我是否了解动画效果问题。请再详细一点好吗？谢谢史蒂夫！非常感谢你阅读了我的问题，也感谢你的帮助：-）你的剧本很有魅力。然而，我发现嵌套在一个组中的方程没有得到转换。有没有办法解决这个问题？谢谢同样奇怪的是，一些文本框正在转换为图像，而另一些则没有。有没有办法只针对带有方程式的文本框？我试过msoTextBox、msoEmbeddedOLEObject、msoLinkedOLEObject、msoPlaceholder、msoolectrolobject、msoauthosape；但没有一个能把所有方程式都转换成。我想提供一个示例PPT，但此处似乎不允许使用附件。您需要添加一个测试，以查看当前形状是否为msoGroup类型，如果是，请查看形状的.GroupItems集合中的每个项目，以查看它是否符合要转换为方程式的形状类型的测试。因为在groups和anon中也可能有组，所以您可能希望将其作为递归例程编写。至于你的第二条评论，我没有一个好的答案，但是如果你想在某个地方发布一个示例文件（dropbox，你的网站，无论在哪里），我很乐意看一看。这肯定是我不喜欢的！：-）我将手动进行更改，并希望下一版本的铰接能够解决此问题。非常感谢你抽出时间来帮助我，史蒂夫！非常感谢：-）不可能，普拉萨德。我在第二个答案中添加了另一段代码。。。这是一种演示递归在这种情况下是如何工作的。这听起来很复杂，看起来好像根本不可能。。。但它是有效的

Sub Test()
    Dim oSh As Shape

    For Each oSh In ActivePresentation.Slides(1).Shapes
        DoSomethingToEachShape oSh
    Next

End Sub

Sub DoSomethingToEachShape(oSh As Shape)
    Dim x As Long
    If oSh.Type = msoGroup Then
        For x = 1 To oSh.GroupItems.Count
            DoSomethingToEachShape oSh.GroupItems(x)
        Next
    Else
        Debug.Print oSh.Name
    End If
End Sub