Dokumentschriftarten finden und (einfach) ersetzen in CDR X6?

[fremoikaner]

Hallo!
Danke für die schnelle Reaktion :-)
So habe ich mir das Makro angepasst:

Code:

Sub textFont1()
   Dim p As Page, s As Shape, sr As ShapeRange
   Dim i&, f$, fNew$
 
   f = "Arial" 'your font to find
   fNew = "1451_Eng_DB" 'new font
 
   i = ActivePage.Index
   For Each p In ActiveDocument.Pages
       p.Activate
       Set sr = ActivePage.Shapes.FindShapes(Query:="@type = 'text:artistic'or @type = 'text:paragraph' and @com.text.story.font = '" & f & "'")
       For Each s In sr
           s.Text.Story.Font = fNew
       Next s
   Next p
   ActiveDocument.Pages(i).Activate
End Sub

Wie geschrieben ersetzt er aber alle(!) Schriften.

Gruß
fremoikaner