1

Тема: Не всем символам макрос присваивает нужный шрифт

Добрый день!
Написал нижеследующий макрос для того, чтобы превращать текст, скопированный из пдф, в удобный для работы. Однако после его работы некоторые символы (в приведенном куске - значок умножения, значок градуса и греческая "мю") остаются в ином шрифте (TimesNewRomanPSMT), что заметно по увеличенному межстрочному интервалу, например. Помогает только выделить нужный кусок и вручную присвоить ему Times New Roman. Пробовал то же делать с помощью VBA через последовательный перебор абзацев и даже символов, но ни то, ни другое не помогает.
Вопрос: что можно сделать, чтобы макрос все символы делал таймсом (просто "Times New Roman", а не "TimesNewRomanPSMT")

Sub pdf2doc()
'Делаем ссылки на литературу и показатели степени надстрочными
'Подстрочные тоже делаются надстрочными, но это меньшее зло
With ActiveDocument.Content.Find
    .ClearFormatting
    .Font.Size = 6.5
     With .Replacement
        .ClearFormatting
        .Font.Superscript = True
     End With
.Execute Wrap:=wdFindContinue, Replace:=wdReplaceAll, Forward:=True, FindText:="", ReplaceWith:="", Format:=True
End With
'склеиваем абзацы из пдф
With ActiveDocument.Content.Find
    .MatchWildcards = True
    .ClearFormatting
    .Font.Bold = False
    .Font.Italic = False
    .Font.Superscript = False
     With .Replacement
        .ClearFormatting
    End With
.Execute Wrap:=wdFindContinue, Replace:=wdReplaceAll, Forward:=True, FindText:="([!.\?])^13", ReplaceWith:="\1^32"
End With
ActiveDocument.Content.Font.Name = "Times New Roman"
ActiveDocument.Content.Font.Size = 12
ActiveDocument.Paragraphs.LineSpacingRule = wdLineSpace1pt5
End Sub
Post's attachments

In this study.doc 28 Кб, 2 скачиваний с 2018-03-01 

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

2

Re: Не всем символам макрос присваивает нужный шрифт

Клавицепс пурпуреа пишет:

. . .
Вопрос: что можно сделать, чтобы макрос все символы делал таймсом (просто "Times New Roman", а не "TimesNewRomanPSMT")
. . .

Попробуйте перед последними тремя операторами вставить код, вырезающий весь текст и вставляющий его обратно без форматирования, напр., такие строки:

Selection.WholeStory
Selection.Cut
Selection.PasteAndFormat (wdFormatPlainText)

3

Re: Не всем символам макрос присваивает нужный шрифт

Если следовать этому совету, то пропадет форматирование вообще, а мне нужно сохранить полужирный, надстрочный и т.п.
Поэтому вместо последней предложенной строчки написал:

Selection.PasteAndFormat (wdFormatSurroundingFormattingWithEmphasis)

И сработало!  smile
За подсказку - спасибо!