Корректировка текста, набранного в "ошибочной" раскладке

Замечу, что для решения этой задачи в Office 2000 введена специальная "интеллектуальная" функция, которая распознает ошибку переключения клавиатуры. К сожалению, она правильно работает лишь в тех случаях, когда текст абзаца набирался на одном языке, а затем по ошибке произошло переключение клавиатуры на другой язык. В тех же случаях, когда текст является двуязычным, и каждый абзац может содержать фрагменты текста, например, термины на другом языке, эта функция работает некорректно. Мне она не подходит, я ее отключаю и пользуюсь собственными макросами.

При решении этой задачи я исходил из стандартной клавиатуры, имеющей 101 клавишу. Четыре ряда основных клавишей, используемых для набора русского и английского текста, содержат в двух регистрах 94 символа, не считая символов пробела и табуляции. Цифры и еще 10 символов одинаковы в обеих раскладках, а 74 символа нуждаются в трансляции, когда текст набран не в той раскладке.

Перевод текста из английской раскладки в русскую

Если русский текст набирается в английской раскладке, то при трансляции такого текста все буквы английского алфавита переходят в буквы русского алфавита. Но поскольку русских букв больше, то 14 небуквенных символов английской раскладки транслируются в русские буквы (7 в верхнем и 7 в нижнем регистрах). Кроме того, 7 символов, отличных от буквенно-цифровых, несовпадающие в разных раскладках, также должны быть переведены соответствующим образом.

При написании макроса я сочетал приведенную выше схему трансляции для буквенных символов английского алфавита, имеющих плотную кодировку, и схему разбора случаев для оставшихся символов. Посимвольный разбор случаев нагляден, хотя и не эффективен. В данном случае на некоторую потерю эффективности можно пойти, поскольку макросы применяются, обычно, к сравнительно небольшим текстам. Пришлось также учесть три нюанса, связанных с автоматической коррекцией текста в процессе его набора.

Первый из них таков. В английской раскладке русская буква "э" (большая и малая) задается кавычками - одинарными и двойными. Но тут-то и возникает закавыка, поскольку Word может автоматически заменять прямые кавычки, на другие "изящные" и угловые кавычки, причем кавычки могут быть как открывающие, так и закрывающие. Заменять прямые двойные кавычки могут четыре различные парные кавычки:

Для одинарных кавычек таких замен две. Так что при переводе необходимо учесть, что букве "э" могут соответствовать символы с разной кодировкой (пять или три в зависимости от верхнего или нижнего регистра).

Второй нюанс связан с набором символа "запятая". В английской раскладке этому символу соответствует вопросительный знак "?". Поскольку после запятой в русском тексте, как правило, следует пробел, то эта пара символов в английской раскладке воспринимается как конец вопросительного предложения. Слово, стоящее за запятой, воспринимается редактором Word как начало нового предложения и автоматически корректируется, - его первая буква становится большой и переводится в верхний регистр. При трансляции эту ситуацию необходимо обнаружить и вернуть соответствующий символ в нижний регистр.

Третья ситуация, требующая корректировки, похожа на вторую, но немного сложнее. Букве "ю" соответствует символ "точка". Поэтому, если "ю" заканчивает слово и за ним следует пробел, то символ, следующий за пробелом, Word будет автоматически преобразовывать в верхний регистр, воспринимая символ, как начало предложения. Следовательно, в такой ситуации необходима корректировка с возвращением соответствующего символа в нижний регистр. Но, если символ, следующий за "ю", не является пробелом, то автоматической коррекции не будет.

Несколько слов о переводе буквы "ё". Эта буква не входит в плотную кодировку русского алфавита и, зачастую, ее не рекомендуется использовать при наборе текстов. Тем не менее, я не исключаю возможности ее появления в тексте.

Приведем теперь текст макроса FromEToR, переводящего "английский ошибочный" текст в правильный русский:

Перевод текста из английской раскладки в русскую

Приведем теперь текст макроса FromEToR, переводящего "английский ошибочный" текст в правильный русский:

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.

Перевод текста из русской раскладки в английскую

Макрос FromRToE, решающий обратную задачу по отношению к макросу FromEToR, похож на него в реализации. И здесь возникают некоторые проблемы, связанные с автокоррекцией кавычек. Обратите внимание также на запись строки AlU, задающей перевод русских букв в соответствующие буквы и символы в английской раскладке. Длина этой строки равна 32, а не 33, как может показаться с первого взгляда, поскольку две подряд идущие парные кавычки воспринимаются как один символ. Вот текст макроса:

Public Sub FromRToE() 'Translation of Symbols: Russian --> England Const ALU = "F<DULT:PBQRKVYJGHCNEA{WXIO}SM"">Z" Const AL = "f,dult;pbqrkvyjghcnea[wxio]sm'.z"

Dim Sym As String, Sym1 As Range Dim Index As Byte Dim Result As String Result = "" For Each Sym1 In Selection.Characters Sym = Sym1 Select Case Sym Case "А" To "Я" 'русская буква верхнего регистра Index = Asc(Sym) - Asc("А") + 1 Sym = Mid(ALU, Index, 1) Case "а" To "я" 'русская буква нижнего регистра Index = Asc(Sym) - Asc("а") + 1 Sym = Mid(AL, Index, 1) 'Символы, переходящие в символы Case "?": Sym = "&" Case ".": Sym = "/" Case ",": Sym = "?" Case ";": Sym = "$" Case "№": Sym = "#" Case ":": Sym = "^" Case """": Sym = "@" Case Chr(147): Sym = "@" Case Chr(148): Sym = "@" Case Chr(171): Sym = "@" Case Chr(187): Sym = "@" Case "ё": Sym = "`" Case "Ё": Sym = "~" Case Else: 'Кодировки совпадают End Select 'Устранение результатов автоматической правки текста Result = Result + Sym Next Selection.LanguageID = wdEnglishUS Selection.TypeText Result End Sub

Листинг 2.19.

Перевод кириллицы в латиницу. Макрос FromRuToLat

На основании личного опыта кажется, что макрос FromRuToLat может широко использоваться теми, кто ведет переписку по электронной почте с русскоязычными абонентами, находящимися за рубежом. Главная причина, заставившая меня когда-то в давние времена разработать этот макрос, состояла в том, что возникла необходимость переправлять получаемые по электронной почте русские письма зарубежному русскоязычному абоненту, с которым я работал. Проще было разработать макрос, чем перепечатывать письма или переводить их на английский. Да и самому писать письма приятнее по-русски, писать же их в латинице, забывая периодически, как надо кодировать "щ" или "ы", довольно утомительно.

По своей реализации макрос FromRuToLat ближе всего соответствует общей схеме:

Public Sub FromRuToLat() 'Translation of Symbols: Russian --> Latin Dim ALU( 1 To 32) As String ALU(1) = "A": ALU(2) = "B": ALU(3) = "V": ALU(4) = "G" ALU(5) = "D": ALU(6) = "E": ALU(7) = "J": ALU(8) = "Z" ALU(9) = "I": ALU(10) = "I": ALU(11) = "K": ALU(12) = "L" ALU(13) = "M": ALU(14) = "N": ALU(15) = "O": ALU(16) = "P" ALU(17) = "R": ALU(18) = "S": ALU(19) = "T": ALU(20) = "U" ALU(21) = "F": ALU(22) = "H": ALU(23) = "C": ALU(24) = "Ch" ALU(25) = "Sh": ALU(26) = "Sch": ALU(27) = "'": ALU(28) = "Y" ALU(29) = "'": ALU(30) = "E": ALU(31) = "Yu": ALU(32) = "Ya"

Dim Sym As String, Sym1 As Range Dim Index As Byte Dim S As String Dim Result As String Result = "" For Each Sym1 In Selection.Characters Sym = Sym1 Sym = UCase(Sym) Select Case Sym Case "А" To "Я" ' буква верхнего регистра Index = Asc(Sym) - Asc("А") + 1 S = ALU(Index) If Sym <> Sym1 Then S = LCase(S) 'Символ в нижнем регистре Sym = S Case "Ё" S = "E" If Sym <> Sym1 Then S = LCase(S) 'Символ в нижнем регистре Sym = S Case Else 'Кодировки совпадают Sym = Sym1 End Select Result = Result + Sym Next Selection.TypeText Result End Sub

Листинг 2.20.

Приведение текста к заданному виду

Иногда возникает задача приведения текста к некоторому заданному виду, - произвести соответствующее форматирование текста, изменить шрифт и выполнить другие, подобные операции над текстом. Приведу пример из собственного опыта работы. Когда я копирую тексты процедур из среды редактора VBA, например, при подготовке очередной главы данной книги, то вставленный текст необходимо преобразовать в соответствии с требованиями, предъявляемыми редакцией. Это означает, что необходимо убрать лишние пробелы, заменить концы строк мягкими переносами, изменить шрифт у вставленного текста. Конечно, заниматься подобной работой вручную мне не с руки. Поэтому я написал соответствующий макрос, выполняющий данную работу. Он прост, но тоже поучителен в своем роде, поскольку задача достаточно типичная. Вот текст этого макроса:

Sub RepNew() ' Эта процедура преобразует выделенный программный текст 'Заменяя пробелы табуляцией и конец абзаца мягким концом строки Dim MyRange As Range, TxtRange As String Dim StrFind As String, strReplace As String Debug.Print Val(vbCrLf), Val(vbLf) Set MyRange = Selection.Range TxtRange = MyRange.Text 'Замена концов абзаца StrFind = vbCr 'Chr(13) - Конец абзаца strReplace = vbVerticalTab 'Chr(11) - Разрыв строки TxtRange = Replace(TxtRange, StrFind, strReplace) 'Замена пробелов табуляцией StrFind = " " '4 пробела strReplace = vbTab 'символ табуляции TxtRange = Replace(TxtRange, StrFind, strReplace)

StrFind = " " '3 пробела strReplace = vbTab 'символ табуляции TxtRange = Replace(TxtRange, StrFind, strReplace)

StrFind = " " '2 пробела strReplace = vbTab 'символ табуляции TxtRange = Replace(TxtRange, StrFind, strReplace)

MyRange.Text = TxtRange 'Замена стиля на стиль "Listing", если он встроен Dim MyStyle As Style For Each MyStyle In ActiveDocument.Styles If MyStyle.NameLocal = "Listing" Then MyRange.Style = "Listing" Next MyStyle

End Sub

Листинг 2.21.