Dim Sym As String, Sym1
Public Sub FromEToR() 'Translation of Symbols: England --> Russian Const ALU = "ФИСВУАПРШОЛДЬТЩЗЙКЫЕГМЦЧНЯ" Const AL = "фисвуапршолдьтщзйкыегмцчня" Dim Sym As String, Sym1 As Range Dim Index As Byte Dim Result As String Dim Pravka As Boolean Dim Pravka1 As Boolean Pravka = False Pravka1 = False Result = "" For Each Sym1 In Selection.Characters Sym = Sym1 'Исправление ошибочной автокорректировки If Pravka And (Sym <> " ") Then Sym = LCase(Sym): Pravka = False Select Case Sym Case "A" To "Z" 'английская буква верхнего регистра Index = Asc(Sym) - Asc("A") + 1 Sym = Mid(ALU, Index, 1) Case "a" To "z" 'английская буква нижнего регистра Index = Asc(Sym) - Asc("a") + 1 Sym = Mid(AL, Index, 1) 'Символы, переходящие в символы Case "?": Sym = "," Case "/": Sym = "." Case "^": Sym = ":" Case "$": Sym = ";" Case "&": Sym = "?" Case "@": Sym = """" Case "#": Sym = "№" 'Символы, переходящие в буквы Case ",": Sym = "б" Case "<": Sym = "Б" Case ".": Sym = "ю" Case ">": Sym = "Ю" Case ";": Sym = "ж" Case ":": Sym = "Ж" Case "'": Sym = "э" Case """": Sym = "Э" Case "[": Sym = "х" Case "]": Sym = "ъ" Case "{": Sym = "Х" Case "}": Sym = "Ъ" Case "`": Sym = "ё" Case "~": Sym = "Ё" 'Другие виды кавычек Case Chr(145): Sym = "э" Case Chr(146): Sym = "э" Case Chr(147): Sym = "Э" Case Chr(148): Sym = "Э" Case Chr(171): Sym = "Э" Case Chr(187): Sym = "Э" Case Else: 'Кодировки совпадают End Select 'Обнаружение ошибочной автокорректировки If Sym = "," Then Pravka = True If Pravka1 And (Sym = " ") Then Pravka = True Else: Pravka1 = False End If If Sym = "ю" Then Pravka1 = True 'Формирование результата Result = Result + Sym Next Selection.LanguageID = wdRussian Selection.TypeText Result End Sub |
Листинг 2.18. |
Закрыть окно |