Сохранение форматирования текста 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

Работает нормально, но напрочь сбивается все форматирование. Подскажите, пожалуйста, как заменять с сохранением форматирования


Ответы (0 шт):