Dokumentschriftarten finden und (einfach) ersetzen in CDR X6?
#31
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

Betriebssystem / Grafik-Software: Win7, Corel X3/X5/X7
Zitieren
#32
Hallo fremoikaner,

Mit X7 funktioniert Dein Code.

Ich nehme an, dass X3 Die CQL-Query nicht richtig
auswerten kann und deswegen alles ersetzt.

Du kannst versuchen Die Überprüfung der zu ersetzenden Schriftart in die Schleife zu packen:

Code:
Sub textFont1a()
  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(Type:=cdrTextShape) 'alle Texte suchen
      For Each s In sr
          If s.Text.Story.Font = f Then 'Schriftart prüfen
             s.Text.Story.Font = fNew
          End If
      Next s
  Next p
  ActiveDocument.Pages(i).Activate
End Sub

Das könnte den Ablauf etwas langsamer machen,
aber vielleicht kommt X3 damit zurecht.

Gruß

Koter
[-] 1 Benutzer bedankt sich bei koter für diesen Beitrag:
  • fremoikaner
Zitieren
#33
Hallo koter,

super - so funzt es perfekt :-) Danke!

Ich habe noch die Schriftgröße ergänzt:


Code:
Sub textFont1a()
 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(Type:=cdrTextShape) 'alle Texte suchen
     For Each s In sr
         If s.Text.Story.Font = f Then 'Schriftart prüfen
           If s.Text.Story.Size = 5.7 Then
              s.Text.Story.Font = fNew
           End If
         End If
     Next s
 Next p
 ActiveDocument.Pages(i).Activate
End Sub


Kann ich Dir ein Bier ausgeben?
Gruß
fremoikaner

Betriebssystem / Grafik-Software: Win7, Corel X3/X5/X7
Zitieren
#34
Hallo fremoikaner,

(11.09.2024, 10:20)fremoikaner schrieb: Kann ich Dir ein Bier ausgeben?

vielen Dank! Ist aber nicht nötig.
(habe noch welches im Keller)

Gruß

Koter
Zitieren



Möglicherweise verwandte Themen...
Thema Verfasser Antworten Ansichten Letzter Beitrag
Question Suchen und Ersetzen fehlt in 2023 SE? STONE 0 37 01.10.2024, 12:47
Letzter Beitrag: STONE
  Umriss einer Bildvorlage einfach erstellen anorak 8 183 29.09.2024, 07:49
Letzter Beitrag: Litschi
  Fehlerhafte Knoten-Griffe automatisch finden asterix 47 4.063 23.06.2024, 12:56
Letzter Beitrag: asterix
  Text partiell ersetzen Karthagos 2 385 26.05.2024, 21:09
Letzter Beitrag: Karthagos
  suchen und ersetzen Wild Thinng 4 1.099 07.01.2022, 12:19
Letzter Beitrag: Wild Thinng
  Fehlende Schriften ersetzen Karthagos 4 1.582 17.07.2021, 16:50
Letzter Beitrag: Karthagos
Star nicht verbundene Knoten Finden Karthagos 2 1.642 24.03.2020, 13:40
Letzter Beitrag: Karthagos
  welche Funktion beim Farbe ersetzen ? printx 4 2.403 28.11.2018, 10:10
Letzter Beitrag: norre
  Passende Farbpalette finden Heinzi 6 2.454 11.02.2017, 00:08
Letzter Beitrag: Heinzi
  Konturen finden und gleichmäßige Strichstärke checkbox 10 3.164 01.02.2016, 15:31
Letzter Beitrag: Berlinerillustrator