Question

I am trying to preapre a macro that would convert all equations in a PowerPoint2010 presentation into images while retaining the position and animation effect/order.

Based on the tip provided here (thanks to Steve Rindsberg), I have modified the script as below:

    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

Problems with this script:

1. ALL the equations are not getting converted into images.
2. Some text boxes with no equations are losing their internal anim effects (such as displaying the second bulleted text On Click).

My reason for preparing this script is because when I convert PowerPoint 2010 into Articulate presentations, the equations are not getting rendered properly since Articulate 09 does not fully support PPT2010 equations.

I have more than 100 PPTs, with equations on nearly all slides. Without a programmatic method, the only option would be to convert all the equations manually and reapply the anim effects!

Appreciate any help that you can offer 🙂

Thanks!

Answer 1

As to the first problem, my bad:

For this:

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

Substitute:

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

I probably only tested slides with one equation per slide when I wrote this originally. When you step through a collection and possible delete members, you need to step through backwards, else the indexing gets messed up when you delete a member.