[CDR X5-X8] Поиск и замена шрифта

[NemoSUN]

Помогите написать макрос для поиска и замены одного шрифта на другой. Во всех открытых документах. С заменой даже в блоках. Например, заменить Times New Roman Normal на Arial Bold

 

[dastin]

Edit - Find and Replace ... я так понимаю, не предлагать
Это вам должно помочь

 

[NemoSUN]

Edit - Find and Replace ... я так понимаю, не предлагать
Это вам должно помочь

Да. Так как это поиск только на текущей странице. А мне надо на 300 страницах всё поменять.

 

[dastin]

А мне надо на 300 страницах всё поменять.

дополнить ещё одним циклом перебора страниц
пример
и
если надо ( а при таком количестве страниц - мне кажется не надо)
ещё одним циклом перебора всех открытых документов

 

[NemoSUN]

Edit - Find and Replace ... я так понимаю, не предлагать
Это вам должно помочь

Спасибо за ссылку. Только там, к сожалению, не учитывается вариант написания шрифта - Normal, Bold, Italik....
Я пробовал писать в макросе "Arial Bold" или "Times New Roman Italic". Вообще не ищет. А ищет только по названию шрифта - "Arial" или "Times New Roman".

 

[dastin]

Например, заменить Times New Roman Normal на Arial Bold

Можно ещё попробовать "пошалить" с Panose Fons - если конечно же ваш пример не буквальный (т.е. шрифты не системные)
Удалить из системы шрифт которым набрано - при открытии файла будет предложено заменить отсутствующий щрифт - вы укажете на что заменить

 

[NemoSUN]

Можно ещё попробовать "пошалить" с Panose Fons - если конечно же ваш пример не буквальный (т.е. шрифты не системные)
Удалить из системы шрифт которым набрано - при открытии файла будет предложено заменить отсутствующий шрифт - вы укажете на что заменить

Изначальный шрифт системный (Arial), другой нет (Rubik)
Мне важен учёт варианта написания шрифта - Normal, Bold, Italik....

 

[dastin]

не учитывается вариант написания шрифта - Normal, Bold, Italik....

это чуть другое
cdrFontStyle

Sub Test()
  Dim s As Shape
  Set s = ActiveLayer.CreateArtisticText(4, 5, "Highlight your ideas!")
  s.Text.FontPropertiesInRange(1, 1, cdrWordIndexing).Style = cdrBoldItalicFontStyle
End Sub

 

[NemoSUN]

Sub Test()
  Dim s As Shape
  Set s = ActiveLayer.CreateArtisticText(4, 5, "Highlight your ideas!")
  s.Text.FontPropertiesInRange(1, 1, cdrWordIndexing).Style = cdrBoldItalicFontStyle
End Sub

[/QUOTE]

Я дико извиняюсь. Но здесь назначается свойство. А как сделать в цикле If ? или For....

 

[_MBK_]

Странный вопрос
Так и сделать
if s.Text.FontPropertiesInRange(1, 1, cdrWordIndexing).Style = cdrBoldItalicFontStyle then else endif

 

[NemoSUN]

Сделал так.

Sub sANDrText()
    Dim p As Page, s As Shape, sr As ShapeRange
    Dim i As Long, fnt As String, Newfnt As String
  
    fnt = "Arial" 'your font to find
    Newfnt = "Rubik Light" 'new font
      i = ActivePage.Index
    For Each p In ActiveDocument.Pages
        p.Activate
        Set sr = ActivePage.Shapes.FindShapes(Query:="@type = 'text:artistic' and @com.text.story.font = '" & fnt & "'")
        s.Text.Style = cdrBoldFontStyle
        For Each s In sr
            s.Text.Story.Font = Newfnt
        Next s
    Next p
    ActiveDocument.Pages(i).Activate
End Sub

Не работает.

 

[_MBK_]

Что именно не работает? Условие Query вы правильно записали? А то меня терзают смутные сомнения что нет