1

Тема: Преобразование текста из шрифта GOST type A в стандартный шрифт

Существуют шрифты типа GOST type A, которые не соответствуют стандартным кириллическим шрифтам Word.

Для преобразования текста из шрифта GOST type A в стандартный шрифт Times New Roman может быть использован следующий макрос:

Sub change_GOST_TNR()
'
' Преобразование текста из шрифта GOST type A в шрифт Times New Roman
'
' Назначение всему тексту шрифта Times New Roman
    Selection.WholeStory
    Selection.Font.Name = "Times New Roman"

' Преобразование кириллицы
    For i = 61632 To 61695
        a1 = i
        a = Trim("^u") & Trim(Str(a1))
        ' Шрифт GOST type A - коды ^u61632-^61695)
        b1 = i - 60592
        ' Стандартный шрифт - коды ^u1040-^u1103
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = a
            .Replacement.Text = ChrW(b1)
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i

' Преобразование других символов (за исключением символа ^)
    For i = 61472 To 61533
        a1 = i
        a = Trim("^u") & Trim(Str(a1))
        ' Шрифт GOST type A - коды ^u61472-^u61533
        b1 = i - 61440
        ' Стандартный шрифт - коды ^u32-^u93
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = a
            .Replacement.Text = ChrW(b1)
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i

    For i = 61535 To 61627
        a1 = i
        a = Trim("^u") & Trim(Str(a1))
        ' Шрифт GOST type A - коды ^u61535-^u61627
        b1 = i - 61440
        ' Стандартный шрифт - коды ^u95-^u187
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = a
            .Replacement.Text = ChrW(b1)
            .Forward = True
            .Wrap = wdFindContinue
            .MatchCase = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i

' Назначение тексту параметра «Русский язык»
    Selection.WholeStory
    Selection.LanguageID = wdRussian
    Application.CheckLanguage = True

End Sub

Пример такого преобразования обсуждался в следующей ветке: http://wordexpert.ru/forum/viewtopic.php?pid=7780

Удобной и приятной работы в Word!
Перевести спасибо на Яндекс кошелёк - 41001162202962; на WebMoney - R581830807057.