问题
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:
- ALL the equations are not getting converted into images.
- 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!
回答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.
回答2:
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
来源:https://stackoverflow.com/questions/13393669/macro-to-convert-equations-into-images-in-powerpoint-2010