Программная работа с документами Word

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

Макрос 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

Перевод кириллицы в латиницу. Макрос 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

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

Иногда возникает задача приведения текста к некоторому заданному виду, - произвести соответствующее форматирование текста, изменить шрифт и выполнить другие, подобные операции над текстом. Приведу пример из собственного опыта работы. Когда я копирую тексты процедур из среды редактора 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

Макрос перекодировки

Рассмотрим теперь макрос, который занимается настоящей перекодировкой. Как-то я получил от своего приятеля, работающего теперь за рубежом, письмо по 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

Заметьте, здесь речь идет о кодировке внутри русского алфавита, когда одни символы кодируются другими.

Хронометраж

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

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

Public Sub CodeDA()
Const ALU = "бвчздецъйклмнопртуфхжигюыэящшьас"
Const AL = "БВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС"
Dim Sym As String, Sym1 As Variant
Dim Index As Integer
Dim Result As String
'Переменные, задающие начальное время участка процедуры
Dim Start1 As Single, Start2 As Single, Start3 As Single, Start4 As Single
Dim Start5 As Single, Start6 As Single, Start7 As Single, Start8 As Single
'Переменные, накапливающие время выполнения участка программы
Dim TALL As Single, TSelect As Single, TIndex1 As Single, TIndex2 As Single
Dim TSym1 As Single, TSym2 As Single, TForEach As Single

Dim i As Integer
Start1 = Timer
Result = ""
Start2 = Timer
'Два способа организации цикла!
'For Each Sym1 In Selection.Characters
For i = 1 To Selection.Characters.Count
	Sym1 = Selection.Characters(i)

	Start3 = Timer
	Sym = Sym1
	'Два способа организации разбора случаев
	'Select Case Sym
	'Case "А" To "Я" 'русская буква верхнего регистра
	If Sym >= "А" And Sym <= "Я" Then
	
		Start5 = Timer
		Index = Asc(Sym) - Asc("А") + 1
		TIndex1 = TIndex1 + Timer - Start5
		Start6 = Timer
		Sym = Mid(ALU, Index, 1)
		TSym1 = TSym1 + Timer - Start6
	'End If
	'Case "а" To "я" 'русская буква нижнего регистра
	 ElseIf Sym >= "а" And Sym <= "я" Then
		Start7 = Timer
		Index = Asc(Sym) - Asc("а") + 1
		TIndex2 = TIndex2 + Timer - Start7
		Start8 = Timer
		Sym = Mid(AL, Index, 1)
		TSym2 = TSym2 + Timer - Start8
	 'End Select
	 End If
	 TSelect = TSelect + Timer - Start3
	Result = Result + Sym
Next
	TForEach = TForEach + Timer - Start2
Selection.LanguageID = wdRussian
Selection.TypeText Result
	TALL = TALL + Timer - Start1
	Debug.Print "TAll = ", TALL
	Debug.Print "TForEach = ", TForEach
	Debug.Print "TSelect = ", TSelect
	Debug.Print "TIndex1 = ", TIndex1
	Debug.Print "TIndex2 = ", TIndex2
	Debug.Print "TSym1 = ", TSym1
	Debug.Print "TSym2 = ", TSym2

End Sub

Приведу данные хронометража результатов испытания работы этой процедуры на одном из текстов.

Поговорим о полученных результатах. Прежде всего, обратите внимание на разброс значений от эксперимента к эксперименту. Этот разброс всегда следует иметь в виду, хотя он, конечно, не искажает качественной картины построения временного профиля. Данные в таблице 1 приведены для случая, когда в макросе используется конструкция For Each для получения очередного символа коллекции Characters и конструкция Select - Case для разбора случаев и анализа того, каким является очередной символ. Вот некоторые выводы, которые можно сделать, анализируя полученные результаты:

1. Основное время работы данной процедуры, примерно 2 секунды, затрачивается на организацию цикла (конструкцию For Each ) и организацию разбора случаев (конструкцию Select - Case ).
2. На организацию цикла и разбор случаев тратится примерно равное время, чуть более секунды на организацию цикла и чуть менее секунды на организацию разбора случаев.
3. Внутренние операторы конструкции Case, связанные с выполнением встроенных функций Asc и Mid, занимают пренебрежимо малое время в сравнение со временем, требуемым для организации конструкций цикла и разбора случаев, не более 5% от времени работы конструкции Select.

Заменим теперь конструкцию:

Select Case Sym
	Case "А" To "Я"
		<операторы1>
 Case "а" To "я"
		<операторы2>
End Select
на конструкцию:
If Sym >= "А" And Sym <= "Я" Then
		<операторы1>
ElseIf Sym >= "а" And Sym <= "я" Then
		<операторы1>
End If

Результаты вычислений в этом случае показаны в следующей таблице:

На данном примере трудно понять, какая конструкция работает эффективнее. Разброс значений соизмерим с погрешностью измерений. Я все-таки рекомендую применять конструкцию Select - Case в подобных ситуациях.

Приведем теперь более впечатляющие результаты, заменив конструкцию цикла:

For Each Sym1 In Selection.Characters

на обычный цикл:

For i = 1 To Selection.Characters.Count
	Sym1 = Selection.Characters(i)

Вот как выглядят результаты временных замеров в этом случае:

Заметьте, вместо одной секунды на выполнение того же цикла теперь ушло около двух минут. Когда я впервые узнал, что при работе с коллекциями время, затрачиваемое на организацию старого, доброго и привычного цикла For I = 1 To N на два порядка больше времени работы цикла For Each, сказать, что я был поражен, слишком слабо. До сих пор не могу найти объяснения этому факту. Тем не менее этот факт имел место и в Office 97, такая же ситуация сохраняется и в Office 2000. Поэтому всегда в своих программах используйте, где можно цикл For Each - от этого существенно зависит эффективность выполнения ваших программ.