1

Тема: Макрос замены шрифта

Доброго дня, Эксперты)

Имеется следующая задача:

Допустим есть некий ворд-документ, основной шрифт которого Times New Roman, так же имеется парочка дополнительных шрифтов, которыми набраны списки и цитатки, к примеру Calibri  и Courier.

Но кое-где по тексту встречаются слова набранные шрифтом Arial, как так вышло не ясно, наверное при копировании, или преобразовании форматов, не суть.

Хотелось бы получить макрос, который на выходе менял всё что набрано Ариалом на Таймс, не затрагивая при этом условные Calibri, Courier, и другие шрифты, если они там вдруг будут.

Заменой это делается довольно просто, но при попытке записать макрос, на выходе получается код, который не работает так как нужно, а именно вообще никак не работает.

Привожу код в закрепе. Помогите пожалуйста в написании такого макроса.

Post's attachments

code.txt 519 b, 4 скачиваний с 2019-02-12 

You don't have the permssions to download the attachments of this post.

2

Re: Макрос замены шрифта

andrrrew пишет:

. . .
Хотелось бы получить макрос, который на выходе менял всё что набрано Ариалом на Таймс, не затрагивая при этом условные Calibri, Courier, и другие шрифты, если они там вдруг будут.

Заменой это делается довольно просто, но при попытке записать макрос, на выходе получается код, который не работает так как нужно, а именно вообще никак не работает.

Привожу код в закрепе. Помогите пожалуйста в написании такого макроса.
. . .

Попробуйте добавить в код определение имен шрифтов для поиска и замены соответственно в объектах Selection.Find и Selection.Find.Replacement, например:

Sub testing()
'
' testing Macros
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Font.Name = "Arial"
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Name = "Times New Roman"
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

3

Re: Макрос замены шрифта

А по другому нормально и не получится.

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

4

Re: Макрос замены шрифта

Этот ответ хорош. Спасибо большое.

Попробуйте добавить в код определение имен шрифтов для поиска и замены соответственно в объектах Selection.Find и Selection.Find.Replacement, например:

Sub testing()
'
' testing Macros
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Font.Name = "Arial"
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Name = "Times New Roman"
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub