Макрос перекодировки
Рассмотрим теперь макрос, который занимается настоящей перекодировкой. Как-то я получил от своего приятеля, работающего теперь за рубежом, письмо по Email в кириллице, но в кодировке, не распознаваемой в Outlook. Поскольку письмо начиналось с обращения ко мне по имени и отчеству, то раскодировать его вручную не представляло особого труда, хотя и потребовало времени. Работа по определению кода всегда представляет некоторый интерес, вспомните Шерлока Холмса в "Пляшущих человечках". Но, когда я получил второе письмо в той же кодировке, то я предпочел написать макрос, на что потребовалось гораздо меньше времени, чем на расшифровку этого письма по известному коду. Текст этого макроса реализован в полном соответствии с рассмотренной общей схемой:
Public Sub CodeDA() 'Кодировка Rus -> Rus Const ALU = "бвчздецъйклмнопртуфхжигюыэящшьас" Const AL = "БВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС" Dim Sym As String, Sym1 As Variant Dim Index As Integer 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) End Select Result = Result + Sym Next Sym1 Selection.LanguageID = wdRussian Selection.TypeText Result
End Sub
Листинг 2.22.
(html, txt)
Заметьте, здесь речь идет о кодировке внутри русского алфавита, когда одни символы кодируются другими.