Сохранение форматирования текста VBA Word
Требуется выполнить транслитерацию исходного текста с сохранение форматирования без использования Selection. Есть такой код:
Function Translit(ByVal txt As String) As String ' с учётом регистра символов
txtRussian$ = "абвгдеёжзийклмнопрстуфхцчшщъыьэюя"
arrTranslit = Array("", "a", "b", "v", "g", "d", "e", "yo", "zh", "z", "i", "j", "k", _
"l", "m", "n", "o", "p", "r", "s", "t", "u", "f", "kh", "c", "ch", _
"sh", "shh", "''", "y", "'", "e'", "yu", "ya")
For iCount% = 1 To 33
txt$ = Replace(txt$, Mid(txtRussian$, iCount%, 1), arrTranslit(iCount%), , , vbBinaryCompare) ' строчные
txt$ = Replace(txt$, UCase(Mid(txtRussian$, iCount%, 1)), UCase(arrTranslit(iCount%)), , , vbBinaryCompare) ' прописные
Next
Translit$ = txt$
End Function
Sub Макрос_из_кириллицы_в_латиницу()
Dim txt
txt = ActiveDocument.Range()
newTxt = Translit(txt)
ActiveDocument.Content.InsertAfter Text:=Chr(13) + newTxt
End Sub
Работает нормально, но напрочь сбивается все форматирование. Подскажите, пожалуйста, как заменять с сохранением форматирования