Sub ConverToCurves_all()
Dim p As Page
Dim g, g1 As Double
g = 0
g1 = ActiveDocument.ActivePage.Index
ActiveDocument.BeginCommandGroup "所有转曲"
For Each p In ActiveDocument.Pages
p.UnlockAllShapes
g = g + Pconvert(p.Shapes)
Next p
If g1 > ActiveDocument.Pages.Count Then g1 = (g1 - 65536) / 131074 * 2 '判断是否对开页
If g1 = 0 Then g1 = 1
ActiveDocument.Pages(g1).Activate
ActiveDocument.EndCommandGroup
If g = 0 Then
MsgBox "没有找到文本！", vbInformation
Else
MsgBox "共有" + Str(g) + " 个文本对象,并转曲"
End If
End Sub
Sub ConverToCurves_ActivePage()
Dim g As Double
g = 0
ActiveDocument.BeginCommandGroup "当前转曲"
ActiveDocument.ActivePage.UnlockAllShapes
g = Pconvert(ActivePage.Shapes)
ActiveDocument.EndCommandGroup
If g = 0 Then
MsgBox "没有找到文本！", vbInformation
Else
MsgBox "共有" + Str(g) + " 个文本对象,并转曲"
End If
End Sub
Private Function Pconvert(sr As Shapes) As Double
Dim s As Shape
Dim g1 As Double
Dim sr1 As ShapeRange
g1 = 0
For Each s In sr
If Not s.PowerClip Is Nothing Then
g1 = Pconvert(s.PowerClip.Shapes)
End If
Next s
Set sr1 = sr.FindShapes(, 6)
sr1.ConvertToCurves
g1 = g1 + sr1.Count
Pconvert = g1