08.02.2015, 02:05
norre schrieb:...es wandelt allen Text im Dokument in Kurven, außer dieser liegt im Powerclips...
Hallo Norre,
Dieser Code berücksichtigt auch Powerclips:
Code:
Sub AlleTexteInKurven()
Dim Texte As ShapeRange
Dim temp As New ShapeRange
Dim Seite As Page
Dim s As Shape
Set col = Nothing
For Each Seite In ActiveDocument.Pages
Set Texte = FindAllShapes(Seite.Shapes.All).Shapes.FindShapes(Type:=cdrTextShape)
For Each s In Texte
If s.Type = cdrTextShape Then
s.ConvertToCurves
If s.Type = cdrGroupShape Then
If s.Shapes.Count < 2 Then
temp.Add s
End If
End If
End If
Next
Next
For Each s In temp.Shapes
s.Ungroup
Next
End Sub
Function FindAllShapes(sr As ShapeRange) As ShapeRange
Dim s As Shape
Dim srAll As New ShapeRange, srPowerClipped As New ShapeRange
Do
For Each s In sr.Shapes.FindShapes(Query:="!@com.powerclip.IsNull")
srPowerClipped.AddRange s.PowerClip.Shapes.FindShapes()
Next s
srAll.AddRange sr
sr.RemoveAll
sr.AddRange srPowerClipped
srPowerClipped.RemoveAll
Loop Until sr.Count = 0
Set FindAllShapes = srAll
End Function
Die Funktion „FindAllShapes“ habe ich von von Shelby gemoppst.
Gruß
Koter