View Single Post
Old 19-09-2011, 09:31
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,787
Blog Entries: 11
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Pages, Groups, Powerclips

I am getting old, took me a few minutes to remember how to do this in version 12. :-) This should work.
Public Sub ConvertALLTextToCurves()
    Dim p As Page
    For Each p In ActiveDocument.Pages
        ConvertShapes p.Shapes
    Next p
End Sub

Private Sub ConvertShapes(ss As Shapes)
    Dim s As Shape
    For Each s In ss
        Select Case s.Type
            Case cdrTextShape
                ConvertShapeCurves s
            Case cdrGroupShape
                ConvertShapes s.Shapes
        End Select
        On Error Resume Next
        If Not s.PowerClip Is Nothing Then
            ConvertShapes s.PowerClip.Shapes
        End If
    Next s
End Sub

Private Sub ConvertShapeCurves(s As Shape)
    Dim strName As String
    strName = s.Text.FontProperties.Name & " (size: " & s.Text.FontProperties.Size & " pt)"
    s.Name = strName
End Sub
Best of luck,

Reply With Quote