Тема: Не всем символам макрос присваивает нужный шрифт
Добрый день!
Написал нижеследующий макрос для того, чтобы превращать текст, скопированный из пдф, в удобный для работы. Однако после его работы некоторые символы (в приведенном куске - значок умножения, значок градуса и греческая "мю") остаются в ином шрифте (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