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

Инструментальная панель и кнопки

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

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

Множественный буфер

Долгожданной новинкой, появившейся в Office 2000, было введение буфера, в котором может храниться не единственное значение, а множество значений. Теперь буфер позволяет одновременно хранить до 16 различных объектов, что, несомненно, бывает крайне полезным в работе пользователя, когда часто приходится использовать в тексте повторяющиеся термины, фразы, рисунки.

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

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

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

Option Explicit

'Множественный буфер можно задать массивом или динамической структурой
'Я предпочитаю использовать динамическую структуру
Public MultBuffer As New Collection
Public Elem As Range
Public NumElem As Integer

Переменная MultBuffer задает множественный буфер, а переменные Elem и NumElem мне понадобятся для работы с элементами, хранящимися в буфере.

Основной вопрос, который предстоит решить, как показать пользователю, элементы, хранящиеся в буфере? Очевидно, это должен быть некоторый список элементов. Но каково должно быть содержимое элементов, предъявляемых пользователю для показа? Проблема в том, что объекты, хранящиеся в буфере, могут быть достаточно сложными - длинные тексты, рисунки, Ole-объекты, комбинация текста и рисунков и так далее. Я выберу решение этой задачи, подсказанное стандартной реализацией, - там, где объект содержит текст, пользователю будет предъявлен начальный участок этого текста. Для графических объектов и им подобным - элементам документа Word, входящим в коллекции Shapes и InlineShapes, пользователю будет предъявлено слово "ОбъектN", где N будет задавать номер такого объекта.

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

Другое возможное решение состоит в том, чтобы для отображения списка использовать панель инструментов со специальными кнопками, в частности, иметь на панели кнопку класса ComboBox типа DropDown. Эта кнопка также позволяет динамически формировать список ее элементов и задавать реакцию на выбор определенного элемента из списка. О работе с такими кнопками я расскажу в следующей лекции. Сейчас мы рассмотрим оба варианта реализации, поскольку оба они интересны с программистской точки зрения.

Реализация множественного буфера, основанная на форме

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

Три командные кнопки, помещенные в форму, - "Вставить элемент", "Удалить элемент" и "Удалить все" - выполняют основные операции над элементами буфера. Отмечу одно важное свойство, установленное при проектировании формы BufferForm. Я сделал эту форму немодальной, установив булево свойство ShowModal как False. Это позволяет держать форму открытой при работе с документом и при необходимости вставлять нужные элементы из открытого списка.

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

Public Sub CopyMult()
	'Этот макрос копирует выделенный объект в множественный буфер
	MultBuffer.Add Selection.Range
 End Sub

Как видите, в макросе копирования элементов в буфер для добавления элементов в коллекцию, используется метод Add, вся задача выполняется одним оператором и не требует особых пояснений. Заметьте, в коллекцию полностью добавляется выделенный объект, а не его текст или другие компоненты.

Конечно, в этот же момент можно было бы создавать и соответствующий элемент списка нашей формы. Но разумнее это делать в другом месте - в обработчике события, возникающего при активизации формы. Действительно, если представить, что форма уже открыта и расположена на экране, то программное добавление нового элемента в ее список не будет отображаться, пока форма не будет перерисована. Раз так, то целесообразнее каждый раз при активизации формы (появлении ее на экране) создавать список на основе текущего состояния множественного буфера - коллекции MultBuffer. Вот как выглядит для формы написанный мной обработчик события Activate, решающий задачу создания элементов списка формы. Естественно, что список создается на основе анализа состояния буфера:

Private Sub UserForm_Activate()
	Dim Txt As String
	NumElem = 0
	For Each Elem In MultBuffer
		'Анализ типа элемента буфера и создание элемента списка
		If Elem.Characters.Count = 1 Then
			'Это объект Shape, InlineShape,
			'специальный или однобуквенный символ!
			NumElem = NumElem + 1
			Txt = "Object"  NumElem
		Else: Txt = Left(Elem.Text, 40)
		End If
		'Добавление элемента в список формы
		ListBox1.AddItem Txt
	Next Elem

End Sub

В цикле по объектам коллекции, составляющим буфер, анализируется их тип, и создаются текстовые элементы, представляющие элементы списка нашей формы. Заметьте, я достаточно просто расправляюсь с проблемой распознавания типа объекта, хранящегося в буфере. Для распознавания я использую следующий факт, - для всех рисованных объектов, объектов WordArt и подобных им объектов документа Word, свойство текст задается одним специальным символом. Поэтому я применяю следующее правило, - все объекты буфера, для которых свойство Characters возвращает коллекцию символов, содержащую ровно один символ, относятся к нетекстовым объектам или не могут, я полагаю, быть распознанными пользователем по этому символу. Поэтому такие объекты должны отображаться в списке словом "Объект" с соответствующим номером. Под это определение подпадают объекты Shape и InlineShape, специальные символы и, конечно, просто однобуквенные символы. Конечно, можно было бы предусмотреть более сложный анализ, но и принятое решение представляется вполне разумным и вполне удовлетворительно, как мне кажется, на практике. Некоторое сомнение может возникать в тех случаях, когда действительно копируются однобуквенные символы, но, заметьте, специальные символы целесообразно считать объектами, а простые символы вряд ли стоить копировать в множественный буфер. Далее я все-таки покажу, как можно было бы более детально проанализировать тип объекта, хранящегося в буфере.

Итак, задача создания буфера и списка, отражающего его элементы, решена полностью. Давайте теперь рассмотрим работу по вставке элементов из буфера и другие операции, реализованные над этими элементами. Прежде всего, замечу, что, как обычно, я спроектировал специальную инструментальную панель "MultBufferPanel" и расположил на ней две командные кнопки: "CopyMult" и "PasteMult". В ответ на нажатие первой кнопки вызывается уже приведенный одноименный макрос "CopyMult". В обработчике события нажатия второй кнопки вызывается макрос "PasteMult". Текст его очень прост:

Public Sub PasteMult()
	'Показывает форму с элементами буфера
	BufferForm.Show
End Sub

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

Private Sub CommandButton1_Click()
	InsertElem
End Sub

Public Sub InsertElem()
	'Вставляет выбранный элемент буфера
	'в точку, заданную курсором
	Dim RowIndex As Integer
	Dim Sel As Boolean
	Sel = False
	With BufferForm.ListBox1
		For RowIndex = 0 To .ListCount - 1
			If .Selected(RowIndex) Then
				Sel = True
				Set Elem = MultBuffer(RowIndex + 1)
				If Elem.ShapeRange.Count > 0 Then
					'Это объект Shape - он не привязан
					'к фиксированному положению, не может быть
					'помещен в точку, заданную курсором и копируется
					'специальным методом Duplicate
					Elem.ShapeRange(1).Duplicate
				Else
					Elem.Copy
					Selection.PasteSpecial
			End If
				Exit For
			End If
		Next RowIndex
		If Not Sel Then
			MsgBox ("Для вставки выберете элемент из списка!")
		End If
	End With
End Sub

Несколько слов о том, как реализована вставка. Вначале я определяю, какой элемент списка выбран, что позволяет определить индекс элемента буфера (коллекции), который должен быть вставлен в позицию курсора. На этом этапе также приходится анализировать тип вставляемого объекта, поскольку объекты Shape не могут быть вставлены в позицию, заданную курсором. Более того, они не могут быть скопированы стандартным способом через буфер, для них приходится применять метод Duplicate, специально предназначенный для этих целей. Заметьте, в данной ситуации необходимо более корректно анализировать тип объекта, находящегося в буфере. Для распознавания того, что объект буфера принадлежит классу Shape, я вызываю метод RangeShape, возвращающий коллекцию Shapes объекта Range. Если эта коллекция не пуста, то имеем дело с объектом Shape.

Для остальных объектов, не принадлежащих классу Shape, вставка выполняется через стандартный буфер, о чем я уже говорил в предыдущем параграфе, где рассматривалась работа с одиночным буфером.

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

Private Sub CommandButton2_Click()
	DelElem
End Sub

Public Sub DelElem()
	'Удаляет выбранный элемент буфера
	
	Dim RowIndex As Integer
	Dim Sel As Boolean
	Sel = False
	With BufferForm.ListBox1
		For RowIndex = 0 To .ListCount - 1
			If .Selected(RowIndex) Then
				Sel = True
				MultBuffer.Remove (RowIndex + 1)
				.RemoveItem RowIndex
				Exit For
			End If
			RowIndex = RowIndex + 1
		Next RowIndex
		If Not Sel Then
			MsgBox ("Для удаления выберете элемент из списка!")
		End If
	End With
End Sub

Заметьте, выбранный элемент удаляется как из списка, так и из буфера

Кнопка "Удалить все" позволяет полностью очистить буфер и, соответственно, список формы. По сути, макрос, решающий эту задачу, не многим отличается от макроса, удаляющего один элемент:

Private Sub CommandButton3_Click()
	ClearAll
End Sub

Public Sub ClearAll()
	'Удаляет элементы из буфера (коллекции)
	Dim i As Integer
	For i = 1 To MultBuffer.Count
		MultBuffer.Remove (1)
	Next i
	'Удаляет элементы из списка
	For i = 1 To BufferForm.ListBox1.ListCount
		BufferForm.ListBox1.RemoveItem (0)
	Next i
	BufferForm.Hide
End Sub

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

Реализация множественного буфера, основанная на кнопке класса ComboBox

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

Заметьте, этот прием может быть полезен не только в данном конкретном примере, но и во многих случаях, когда приходится предъявлять пользователю некоторый список для того, чтобы он сделал в нем свой выбор. Кнопка меню, конечно же, компактнее, чем отдельная открывающаяся форма. Именно по этой причине такой способ работы с множественным буфером может быть предпочтительнее.

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

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

Две кнопки в первой группе RangeShape и PasteMult позволяют работать с множественным буфером, основанным на первой его реализации. Вторая группа кнопок предназначена для работы с буфером, основанным на втором способе реализации. Кнопка Copy1Mult позволяет копировать выделенный объект в документе Word в буфер, основанный на рассматриваемой нами DropDown реализации. Вторая кнопка, созданная программно, имеет тип DropDown и используется для выбора и вставки нужного элемента буфера в позицию, заданную курсором. Кнопка DelAll предназначена для чистки буфера, а кнопка InsertAll для вставки всех элементов буфера в позицию, заданную курсором. Заметьте, иногда такая операция бывает полезной. Также как и в стандартной реализации, отсутствует операция, позволяющая удалять единственный выбранный элемент буфера. Причина этого понятна, - выбор элемента в списке кнопки однозначно определяет и операцию, выполняемую над этим элементом. Такой операцией является операция вставки выбранного элемента. Для удаления элемента потребовалось бы иметь еще одну кнопку типа DropDown.

Все кнопки на панели MultBufferPanel можно создать руками, что я и делал. Единственным исключением является кнопка DropDown, которую нужно создавать программно. Рассмотрим, как это делается. Приведу сейчас тексты всех используемых мной процедур:

Public Function ExistCommandBar(PanelName As String) As Boolean
	'Возвращает True, если в коллекции CommandBars
	'существует панель с именем PanelName
	Dim bar As CommandBar, Exist As Boolean
	Exist = False
	For Each bar In CommandBars
		If bar.name = PanelName Or bar.NameLocal = PanelName Then
			Exist = True
			Exit For
		End If
	Next bar
	ExistCommandBar = Exist
End Function

Public Sub AddPanel(PanelName As String)
	'Добавляет и делает видимой панель с именем Panelname
	'в коллекцию Commandbars
	'Панель расположена вверху документа,
	'не заменяет главное меню и не является временной
	If Not ExistCommandBar(PanelName) Then
		Call CommandBars.Add(name:=PanelName, Position:=msoBarTop, _
		MenuBar:=False, Temporary:=False)
	End If
	CommandBars(PanelName).Enabled = True
	CommandBars(PanelName).Visible = True

End Sub

Public Sub CreateComboPanel()
	'Создание панели с элементами класса CommandBarCombobox
	'Создаем панель
	Dim Panel As CommandBar
	Dim Ctrl As CommandBarComboBox
	AddPanel ("MultBufferPanel")
	Set Panel = CommandBars("MultBufferPanel")
	'Добавляем на панель	Combo кнопку типа DropDown - выпадающий список
	Set Ctrl = AddCustomCombo(Panel, "DropdownItem", msoControlDropdown)
	 'Указываем обработчик события при выборе элемента списка
	 Ctrl.OnAction = "DropdownReaction"
	End Sub
Public Function ExistControl(Panel As CommandBar, _
		Capt As String) As Boolean
	'Возвращает True, если в коллекции Controls
	' панели с именем Panel существует элемент с заголовком capt
	Dim Ctrl As CommandBarControl, Exist As Boolean
	Exist = False
	For Each Ctrl In Panel.Controls
		If Ctrl.Caption = Capt Then
			Exist = True
			Exit For
		End If
	Next Ctrl
	ExistControl = Exist
End Function

Public Function AddCustomCombo(Panel As CommandBar, _
			name As String, tip As Variant) As CommandBarComboBox
	'Добавляет на панель элемент, тип которого задан параметром tip
	'возвращая объект CommandBarComboBox	в качестве результата
	Dim Ctrl As CommandBarComboBox
	If Not ExistControl(Panel, name) Then
		Set Ctrl = Panel.Controls.Add(Type:=tip)
		Ctrl.Caption = name
	End If
	Set AddCustomCombo = Panel.Controls(name)
End Function

Основной здесь является процедура CreateComboPanel, при запуске которой будет создана панель с именем MultBufferPanel, если она не была уже создана ранее, и на эту панель будет помещена кнопка типа Dropdown. Обратите внимание, что в этой процедуре задается обработчик события, которому я дал имя DropdownReaction, вызываемый в ответ на выбор пользователем элемента списка. Этот обработчик и будет выполнять основную операцию по вставке элемента буфера в позицию заданную курсором. Текст его приведу чуть позже, а сейчас замечу, что саму работу по добавлению данной кнопки на панель выполняет функция AddCustomCombo, которая не только создает кнопку, но и присваивает ей заголовок (Caption) "DropdownItem".

Нам осталось рассмотреть процедуры, выполняющие основные операции над элементами буфера. Начну с копирования выделенного объекта в буфер. Вот текст соответствующего макроса:

Public Sub Copy1Mult()
	'Этот макрос копирует выделенный объект в множественный буфер
	MultBuffer.Add Selection.Range
	'Одновременно создается список элемента ComboBox
	'на панели MultBufferPanel
	Dim Txt As String
	Dim Panel As CommandBar
	Dim Ctrl As CommandBarComboBox
		If Selection.Range.Characters.Count = 1 Then
			NumElem = NumElem + 1
			Txt = "Object"  NumElem
		Else: Txt = Left(Selection.Range.Text, 40)
		End If
	Set Panel = CommandBars("MultBufferPanel")
	Set Ctrl = Panel.Controls("DropdownItem")
	 'Добавление элемента списка
	 Ctrl.AddItem Txt
End Sub

Заметьте, в отличие от макроса RangeShape в данной реализации не только добавляется элемент в буфер, но его текстовый образ тут же динамически добавляется и в список кнопки DropdownItem.

Как я уже говорил, операция вставки элемента выполняется при выборе элемента из раскрывающегося списка кнопки DropdownItem. Имя макроса - обработчика этого события уже задано в момент создания кнопки. Так что мне остается только привести его текст:

Public Sub DropdownReaction()
	'Обработчик кнопки меню - DropDown ComboBox
	Dim Ctrl As CommandBarComboBox
	Set Ctrl = CommandBars.ActionControl
	
	Set Elem = MultBuffer(Ctrl.ListIndex)
				If Elem.ShapeRange.Count > 0 Then
					'Это объект Shape - он не привязан
					'к фиксированному положению, не может быть
					'помещен в точку, заданную курсором и копируется
					'специальным методом Duplicate
					Elem.ShapeRange(1).Duplicate
				Else
					Elem.Copy
					Selection.PasteSpecial
			End If
End Sub

Обратите внимание, я использую свойство ListIndex, чтобы понять, какой элемент был выбран пользователем из списка. Остальные детали этой процедуры подробно описаны при рассмотрении предыдущей реализации.

Макрос DelAll выполняет чистку буфера и списка:

Public Sub DelAll()
	'Удаляет элементы из буфера и DropDown списка на панели
	Dim i As Integer
	Dim Panel As CommandBar
	Dim Ctrl As CommandBarComboBox
	'Удаляет элементы из буфера (коллекции)
	For i = 1 To MultBuffer.Count
		MultBuffer.Remove (1)
	Next i
	'Удаление из списка
	Set Panel = CommandBars("MultBufferPanel")
	Set Ctrl = Panel.Controls("DropdownItem")
	For i = 1 To Ctrl.ListCount
		Ctrl.RemoveItem (1)
	Next i
End Sub

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

Public Sub InsertAll()
	'Вставка всех элементов из буфера в точку,
	'заданную курсором. Shape-элементы вставляются, как обычно,
	'не привязанные к фиксированной позиции.
	For Each Elem In MultBuffer
		If Elem.ShapeRange.Count > 0 Then
			'Это объект Shape - он не привязан
			'к фиксированному положению, не может быть
			'помещен в точку, заданную курсором и копируется
			'специальным методом Duplicate
			Elem.ShapeRange(1).Duplicate
		Else
			Elem.Copy
			Selection.PasteSpecial
		End If
	Next Elem
End Sub

На этом я завершу рассмотрение способов создания буфера.

Вариации на тему кодирования

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

Прежде чем приводить реализацию частных случаев скажем несколько слов об общей схеме решения задачи трансляции. Для ее решения достаточно построить два массива одинаковой длины Source и Dest, первый - массив исходных символов, требующих перевода, второй - массив строк, задающих перевод каждого символа. Dest(i) задает перевод символа Sourse(i). Разумно задавать Source в виде строки символов, упорядоченных в соответствии с их кодировкой. Если кодирование имеет тип "символ в символ", то и Dest представляется строкой символов. Пусть теперь Text - это исходный текст, подлежащий переводу, а TextResult - результирующий текст после первода. Алгоритм решения задачи трансляции выглядит следующим образом:

TextResult = ""
For Each Sym In Text
	Index = FindIndex(Sym, Source)
	TextResult = TextResult  Dest(Index)
Next

Функция FindIndex определяет индекс вхождения символа Sym в строку Source. Эффективная ее реализация может использовать классический алгоритм бинарного поиска, имеющий сложность logM, где M - длина строки Source (количество символов исходного множества). Общая сложность алгоритма трансляции символов - NlogM, где N - длина текста. Учитывая, что, как правило, M < 256, общая сложность не превосходит 8N. Поиск индекса можно реализовать проще и эффективнее бинарного при условии, что исходное множество символов имеет плотную кодировку, то есть код следующего символа на 1 больше предыдущего. В этом случае используется встроенная функция Asс, возвращающая код символа.

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

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

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

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

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

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

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

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

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

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

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

Приведем теперь текст макроса 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

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

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

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

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 - от этого существенно зависит эффективность выполнения ваших программ.

Работа с текстовыми базами данных

Теперь, когда есть Access и FoxPro, Oracle и SQL Server говорить о текстовых базах данных просто неприлично. Тем не менее, возьму на себя смелость заявить, что и текстовые базы данных будут жить еще очень долго, в том числе и в электронной форме. Кто из нас не пользуется различными справочниками и словарями? Текстовая форма представления таких документов привычна для человека. Поэтому я решил в качестве более сложного примера работы с текстовым документом привести задачу работы с некоторым справочником.

Замечу, что хотя Word и не предназначен для решения подобных задач, в нем есть достаточно средств, используя которые программист может организовать выполнение всех функций, необходимых при работе с тем или иным справочником, словарем, той или иной текстовой базой данных, содержащей, например, информацию о сотрудниках предприятия или магазинах Москвы. О многих способах и объектах, задающих структуризацию текста, я уже говорил. Напомню, всегда есть возможность работы с объектами, задающими коллекции разделов, абзацев, предложений и слов. Добавлю к этому, что структуризация текста задается и за счет использования различных стилей, что широко может использоваться в работе с текстовыми базами данных. Нельзя не упомянуть и коллекцию закладок, специально предназначенных для быстрого поиска нужного фрагмента в текстовом документе. Есть в Word и другие средства, предназначенные для поиска, выделения и вставки фрагментов текста в документ. А что еще нужно при работе со справочником или словарем?

Справочник "Кто есть кто" в компьютерном мире

Задачей, которую собираюсь сейчас привести, я занимался пару лет назад. Известная фирма Dator ежегодно публиковала справочники "Кто есть кто" в компьютерном бизнесе. Готовился к изданию и электронный вариант этого справочника, а я предложил написать к этому варианту макрос, позволяющий пользователям выбрать из этой базы данных интересующих его персон и добавить их в папку "Контакты" приложения Outlook. Электронный вариант справочника так и не появился, и кнопка, преобразующая текстовую базу данных в контакты, так и не увидела свет. И хотя справочник, с которым я работал в то время, теперь уже устарел, но сама по себе задача, на мой взгляд, нисколько не устарела. Я с удовлетворением обнаружил, что, написанная для Office 97 программа прекрасно работает и в среде Office 2000, с удовольствием привожу ее в данной книге. В данном примере не рассматриваются классические задачи работы с электронным справочником по поиску, добавлению или удалению записей справочника, я занимаюсь экзотической, но не менее интересной задачей преобразования текстовой базы данных справочника "Кто есть кто" в базу данных приложения Outlook.

Преобразование данных справочника "Кто есть кто" в контакты Outlook

Приведу точную постановку задачи. Дан справочник персон. Необходимо дать возможность пользователю выбрать из общего списка интересующих его персон, всю возможную информацию о них перенести в базу данных приложения Outlook, в его папку "Контакты". Попутно для каждого из введенных контактов создать ежегодно повторяющееся событие с выдачей своевременного предупреждения о дне рождения контакта. Как видите, задача осложняется тем, что нам придется иметь дело не только с одним приложением Word, необходимо будет обеспечить взаимодействие с приложением Outlook, программно работать с его объектами. Но я предупреждал, что последний пример будет более сложным. Несмотря на то, что объекты Outlook еще не описаны, пример работы с такими объектами, мне кажется, представляет интерес и в данном месте. Что касается первой части этой задачи, собственно работы с документом Word, представляющим справочник, то хотелось бы отметить, что эта задача в тех или иных вариациях возникает при работе со многими подобными документами. Например, из справочника, задающего список товаров, необходимо выбрать нужные товары и сформировать заказ на их покупку.

Структура справочника "Кто есть кто", подготовленного фирмой Dator

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

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

В данном конкретном справочнике применяется все три способа структуризации. Начало каждой записи выделяется соответствующим стилем, именованным "Заголовок2". Этот заголовок содержит фамилию и, как правило, имя и отчество личности, включенной в справочник.

Записи справочника содержат определенные поля:

Некоторые из этих полей обязательны и имеют фиксированное расположение. Так поле "Должность" занимает отдельный абзац, следующий непосредственно за заголовком. Положение остальных полей произвольно, они расположены, как правило, в отдельных абзацах и выделяются ключевыми словами, такими как "адрес", "e-mail" и другими. Абзацы позволяют найти очередное поле, а ключевые слова позволяют определить тип этого поля.

Заметьте, текстовые базы данных предъявляют значительно меньшие требования к структуре информации, чем любые классические системы баз данных. Как видите, длина записи произвольна, запись может содержать разное число абзацев. Некоторые поля могут отсутствовать в записях, порядок следования полей может быть произвольным. О других нарушениях структуры записи я еще расскажу по ходу дела. Система работы с записями в текстовых базах данных может справиться со многими подобными нарушениями структуры, лучше, чем многие специальные базы данных, в этом достоинство таких систем. Чтобы лучше представлять структуру справочника, приведу несколько первых записей этого справочника:

Весь справочник содержит более двухсот подобных записей.

Общий план решения задачи

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

И я начну с того, что приведу описание глобальных переменных, которые будут использоваться в процессе решения задачи. Эти переменные описаны в модуле Tool, в который и будут помещены все основные процедуры, требуемые для решения задачи.

Option Explicit
'Объект Outlook и его компоненты
Public myOl As Outlook.Application, olNameSpace As NameSpace
'Коллекция избранных личностей
Public CollectionOfPersons As New Collection
'Коллекция номеров абзацев, задающих начало записей
Public Numbers As New Collection
Public Con As New Collection
'Определение типа - записи, характеризующей личность
Public Type Person
	FirstName As String
	LastName As String
	MiddleName As String
	Post As String
	DOB As Date
	Address As String
	Tel As String
	Email As String
	Fax As String
	Other As String
End Type

Нам потребовалось описать объект Outlook и связанный с ним объект NameSpace, задающий пространство имен. Описание этих объектов необходимо для обеспечения взаимодействия двух приложений, с тем, чтобы мы могли в проекте документа Word работать с объектами Outlook. Коллекция CollectionOfPersons содержит фамилии персон, входящих в справочник. Две следующие коллекции Numbers и Con носят вспомогательный характер, но важный для общего понимания алгоритма решения. Первая из них содержит номера абзацев, начинающих описание персоны, вторая - порядковые номера персон, отобранных пользователем. Создание этих коллекций позволяет избежать лишних просмотров полного текста документа и получать доступ непосредственно к нужному абзацу. Наконец, в разделе общих объявлений дано определение пользовательского типа Person, формально описывающего запись и поля этой записи, которые будут заполняться в процессе анализа записанной информации, а затем будут переноситься в поля контакта Outlook.

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

Public Sub WTOOL()
'Процедура преобразует справочник персоналий
'в базу данных Контакты приложения Outlook

'Формирование списка персоналий и выбор пользователя
Call FormList
'Создание записей для избранных
Call SelectPerson
End Sub

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

Создание списка персоналий

Для представления списка персоналий я спроектировал, как обычно, форму, в которую поместил элемент управления типа ListBox и командную кнопку. Элементы списка ListBox будут отображать фамилии персон справочника, а обработчик события, возникающего при нажатии командной кнопки, будет вызывать процедуру, выполняющую нужные действия в ответ на выбор пользователя. О том, как проектировать подобную форму, как заполнять элементы списка ListBox, говорилось уже неоднократно, в том числе и в данной лекции. Поэтому основные объяснения будут связаны с тем, как из текстового документа выделить фрагменты, соответствующие записи информации об очередной персоне, как выделить фамилию персоны, отображаемую в списке. Рассмотрением этих вопросов сейчас и займемся. Начну с текста процедуры FormList, решающей поставленную задачу:

Public Sub FormList()
'Эта процедура формирует список личностей
Dim par As Paragraph, parStyle As String
Dim i As Integer, n As Integer
With ActiveDocument
parStyle = .Paragraphs(1).Style
n = ActiveDocument.Paragraphs.Count
i = 1
For Each par In .Paragraphs
 If par.Style = parStyle Then
 'Добавить элемент в список и номер абзаца в коллекцию
	frmPersons.lstPersons.AddItem par.Range.Text
	Numbers.Add i
 End If
 i = i + 1
Next par
End With
frmPersons.Show
End Sub

Как видите, процедура, полностью решающая задачу, получилась довольно короткая и простая. Все это, конечно, благодаря тем возможностям, которые предоставляет Word для этих целей. В цикле (конечно же, For Each ) по всем абзацам текста получаем очередной абзац - объект par. Далее существенно используется тот факт, что информация о каждой персоне начинается с нового абзаца, имеющего специальный стиль, в данном случае, задаваемый переменной parStyle, характерный только для таких абзацев. Используется также и тот факт, что этот абзац содержит только фамилию, имя и отчество персоны.

Затем создаются элементы списка формы. Нетрудно догадаться, что frmPersons - это имя формы, lstPersons - имя списка (элемента управления ListBox ) этой формы. Хочу обратить внимание, на то, что по ходу дела создается коллекция Numbers с номерами абзацев, начинающих информацию об очередной персоне. Эта информация получается почти бесплатно, но в дальнейшем существенно сократит время работы, позволив лишний раз не проходить по всему документу. Последний оператор этой процедуры показывает на экране форму с заполненным списком фамилий персон справочника. Вот как выглядит эта форма в процессе работы с ней:

Создание коллекции "избранных" персон

При нажатии командной кнопки "Выбери нас" создается список, содержащий фамилии персон, выбранных пользователем для занесения информации о них в папку "Контакты". Вот текст вызываемых процедур:

Private Sub cmdSelectPerson_Click()
Dim intLoop As Integer, intSelect As Integer
Dim strSelect As String
Dim ВыборСделан As Boolean
Dim Num As Integer
ВыборСделан = False
intLoop = 0
intSelect = 0
'Поиск выделенных элементов
Do
 If frmPersons.lstPersons.Selected(intLoop) Then
	'Найден очередной элемент
	strSelect = frmPersons.lstPersons.List(intLoop)
	Num = intLoop + 1
	ВыборСделан = True
	intSelect = intSelect + 1
	CollectionOfPersons.Add strSelect
	Con.Add Num
 End If
 intLoop = intLoop + 1
Loop Until intLoop = frmPersons.lstPersons.ListCount
If ВыборСделан Then
	Unload Me
	Set myOl = CreateObject("Outlook.Application")
Else
	MsgBox ("Выбор не сделан")
End If
'Печать коллекции
'For Each pers In CollectionOfPersons
 '	Debug.Print pers
'Next pers
End Sub

Здесь, как бычно, в цикле по всем персонам анализируется множественный выбор пользователя, и фамилии выбранных персон добавляются в коллекцию CollectionOfPersons. Одновременно, добавляются элементы в коллекцию Con, позволяя запомнить порядковые номера выбранных персон в списке. Процедура анализирует, сделал ли пользователь свой выбор, и, если таковой сделан, то после заполнения коллекций форма закрывается. При желании можно включить отладочную печать элементов коллекции CollectionOfPersons. Обратите внимание, в конце работы этой процедуры я создаю объект Outlook, подготавливая почву для следующего этапа работы, когда потребуется создание контактов. Теперь все готово для продолжения работы процедуры WTOOL, вызывающей процедуру SelectPerson, которая выполняет основной и завершающий этап работы.

Создание записи Person

Нам предстоит теперь разобраться с более сложными вопросами. В той части, которая связана с обработкой текстового документа, предстоит понять, как выделить из текста нужную информацию о персоне, для того чтобы создать формальный объект (переменную) созданного нами ранее пользовательского типа Person, и заполнить поля этого объекта. Другая часть работы связана с созданием объекта Outlook - элемента папки Contacts. Давайте посмотрим, как все это можно реализовать. Вот текст процедуры SelectPerson:

Public Sub SelectPerson()

 ' Выделение записи
Dim par As Paragraph, CountPar As Integer
Dim ibeg As Integer, ifin As Integer, nPerson As Integer
Dim PersonRange As Range
Dim i As Integer, Num As Variant
With ActiveDocument
Set PersonRange = .Paragraphs(1).Range
i = 0
'Цикл по записям, отобранных пользователем
For Each Num In Con
	i = i + 1
	'Выделение области документа, занятой записью
	'Номер абзаца, начинающего запись
	ibeg = Numbers(Num)
	'Номер абзаца, заканчивающего запись
	ifin = Numbers(Con(i) + 1) - 1
	PersonRange.Start = .Paragraphs(ibeg).Range.Start
	PersonRange.End = .Paragraphs(ifin).Range.End
	'Выделение записи
	PersonRange.Select
	'Обработать запись - объект Selection
	Call WorkWithSelected
 Next
End With
 myOl.Quit

End Sub

Внешний цикл организован по элементам коллекции Con, элементов у которой ровно столько, сколько персон выделил пользователь для преобразования информации о них в контакты папки Outlook. Первая возникающая задача для каждого элемента этого списка состоит в том, чтобы выделить область текстового документа, в которой записана информация о соответствующей персоне. Чтобы задать эту область - объект Range, достаточно знать параметры Start и End, определяющие местоположение начала и конца области. Вот как можно их определить. Я напомню, что текущий элемент Num коллекции Con задает порядковый номер персоны в списке, тогда по определению коллекции Number номер первого абзаца будет задаваться выражением Number (Num). Номер последнего абзаца записи можно определить, как номер первого абзаца следующей записи, уменьшенный на единицу. Этим алгоритмом я и пользуюсь в процедуре. Заметьте, если не принять дополнительных мер предосторожности, то он приведет к ошибке, когда выбрана последняя запись справочника. Чтобы избежать этого, я использовал стратегию, называемую введением "барьера", добавив в справочник специальную служебную запись (барьер) "Конец записей". Эта запись информирует пользователя об окончании списка персон и, естественно, никогда не будет входить в его выбор. Тем самым удается достаточно просто получить объект Range, задающий фрагмент текстового документа, описывающий информацию о нужной персоне. Выделение этой области задает объект Selection, с которым продолжает работу вызываемая процедура WorkWithSelected. Прежде, чем обсуждать ее работу, приведу ее текст:

Public Sub WorkWithSelected()
'Обработка с выбранной и отмеченной записью
Dim pers As Person, pars As Paragraphs, par As Paragraph
Dim i As Integer, n As Integer
Dim myR As Range
Dim FirstWord As String
Set pars = Selection.Paragraphs
With pers
	'Обработка первого абзаца - фамилии
	Set par = pars(1)
	Set myR = par.Range
	.FirstName = myR.Words(2).Text
	.MiddleName = myR.Words(3).Text
	.LastName = myR.Words(1).Text
	'Обработка должности - следующего непустого абзаца
	Set par = pars(2)
	If par.Range.Words.Count = 1 Then Set par = pars(3)
	Set myR = par.Range
	n = myR.Words.Count
	myR.End = par.Range.Words(n - 1).End
	.Post = myR.Text
	'Обработка оставшихся абзацев
	For Each par In pars
		Set myR = par.Range
		n = myR.Words.Count
		FirstWord = myR.Words(1).Text
		Select Case FirstWord
		 Case "Родился ", "Родилась "
			.DOB = SelectDate(par.Range)
		 Case "Тел"
			myR.Start = par.Range.Words(3).Start
			myR.End = par.Range.Words(n - 1).End
			.Tel = myR.Text
		 Case "Факс"
			myR.Start = par.Range.Words(3).Start
			myR.End = par.Range.Words(n - 1).End
			.Fax = myR.Text
		 Case "Адрес"
			myR.Start = par.Range.Words(3).Start
			myR.End = par.Range.Words(n - 1).End
			.Address = myR.Text
		 Case "e"
			myR.Start = par.Range.Words(5).Start
			myR.End = par.Range.Words(n - 1).End
			.Email = myR.Text
		 Case Else
		 .Other = .Other + myR.Text
		End Select
	Next par
	If Not IsDate(.DOB) Then .DOB = "1 января "
 'Debug.Print Selection.Range.Text
 'Debug.Print .FIO, .Post, .Address, .DOB, .Tel, .Fax, .Email, .Other
End With
'Запись создана - теперь создается контакт в Outlook
Call WriteToContact(pers)
End Sub

В этой процедуре заполняются поля переменной pers пользовательского типа Person. При этом существенно используются принятые соглашения о структуре справочника. Так по предположению первый абзац содержит только информацию о фамилии, имени и отчестве персоны, так что анализ первых трех слов этого абзаца позволяет заполнить поля LastName, FirstName и SecondName записи pers. Следующий абзац, который может следовать сразу за первым или быть отделенным пустым абзацем, содержит информацию о должности персоны. Запоминается весь текст этого абзаца, который и определяет описание должности персоны. Заметьте техническую деталь, при формировании данного поля из коллекции Words, задающей слова абзаца, удаляется последнее слово, в котором записан символ конца абзаца. Это же правило применяется и при работе с другими полями. При заполнении других полей не предполагается жесткий порядок их следования в тексте документа. Распознавание идет по ключевым словам, начинающим абзац, и программно осуществляется разбором случаев. Так заполнялись поля, определяющие телефон, факс, адрес и другие, подобные им. Все абзацы, не содержащие заданных ключевых слов, составляли поле Other. Пожалуй, наибольшую трудность вызывает распознавание даты рождения персоны. Дело в том, что для записи даты используются различные форматы, сокращения и прочие особенности. Более того, некоторые из персон, в особенности женщины, предпочитали не указывать год рождения, а мужчины не считали необходимым указывать число и месяц рождения. Чтобы справиться, хотя бы частично, с возникающими проблемами, я написал отдельную процедуру, занимающуюся разбором даты рождения. Вот ее текст:

Public Function SelectDate(ran As Range) As String
Dim Dat As String
With ran
If .Words(3) = "февраля " Then .Words(3) = "фев "
Dat = .Words(2)  .Words(3)  .Words(4)
If IsDate(Dat) Then
	SelectDate = Dat
 Else
 Dat = .Words(2)  .Words(3)
 If IsDate(Dat) Then
	SelectDate = Dat
 Else
	Dat = "1 января "  .Words(3)
	If IsDate(Dat) Then
	SelectDate = Dat
 Else
	Dat = "1 января "
	End If
 End If
End If

End With
End Function

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

?IsDate("13 февраля 1961")
False
?IsDate("13 фев. 1961")
True

В этой процедуре я не старался исправить все возможные ошибки, скорее я проверял корректность той или иной комбинации, используя для проверки функцию IsData, возвращающую истину, когда ее аргумент является правильной датой с точки зрения Office 2000. Если же установить дату рождения не удавалось, то в качестве даты принималась некоторая условная дата (1 января текущего года), что позволяло позже при работе с контактом понимать, что точная дата рождения контакта не известна.

По завершении формирования записи pers эта запись в качестве аргумента передавалась при вызове процедуры WriteContact, в которой и реализована работа с объектами Outlook.

Контакты и другие объекты Outlook

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

Public Sub WriteToContact(pers As Person)
'Создание нового контакта в Outlook и запись данных о нем
Dim newContact As ContactItem
Set newContact = myOl.CreateItem(olContactItem)
'newContact.Display
With newContact
 .BirthDay = pers.DOB
 .FirstName = pers.FirstName
 .MiddleName = pers.MiddleName
 .LastName = pers.LastName
 .BusinessFaxNumber = pers.Fax
 .BusinessTelephoneNumber = pers.Tel
 .BusinessAddress = pers.Address
 .Email1Address = pers.Email
 .JobTitle = pers.Post
 .Save
 End With
' newContact.Save
 'Включить предупреждение о дне рождения
 Dim myFolder As MAPIFolder
Dim newAppointment As Object
Set olNameSpace = myOl.GetNamespace("MAPI")
Set myFolder = olNameSpace.GetDefaultFolder(olFolderCalendar)
Set newAppointment = myFolder.Items(myFolder.Items.Count)
	With newAppointment
		.ReminderSet = True
		.ReminderMinutesBeforeStart = 1440
		.Save
	End With

End Sub

Начну с нескольких общих замечаний. Прежде всего, хочу успокоить, что мои запугивания насчет сложности данной задачи, работающей с объектами Outlook, являлись лишь обычной "страшилкой" для начинающих. Ничего сложного в работе с объектами Outlook, также как и с другими объектами нет, нужно только с ними познакомиться. Истины ради, следует сказать, что объектная модель Outlook существенно отличается по принципам построения от объектной модели таких приложений, как Word и Excel. Например, на верхнем уровне нет привычных коллекций, - вместо них используются объекты - папки (Folders). Соответственно нет метода Add, создающего новый элемент и добавляющего его в коллекцию. Вместо этого элемент создается методом CreateItem и добавляется в папку при выполнении метода Save, при этом тип папки, в которую попадает элемент, определяется по типу созданного элемента. Имеются некоторые тонкости в способе получения той или иной папки. Поскольку у самого объекта Outlook.Application нет на верхнем уровне коллекции Folders то, для того чтобы добраться в Outlook до соответствующей папки, нужно вначале получить дополнительный объект olNameSpace класса NameSpace. И уже этот объект позволяет добраться до нужной папки. Все это не то, чтобы сложно, но нет ощущения интуитивной ясности и простоты.

В одной из последующих лекций я собираюсь дать подробное описание объектной модели Outlook. Судя по письмам моих читателей, интерес к программированию, использующему объекты Outlook, возрастает, а белых пятен здесь еще много. Но давайте вернемся к нашему примеру.

Чтобы создать в приложении Outlook новый контакт - объект класса ContactItem, - я использую метод CreateItem, аргументом которого являются встроенные константы, каждая из которых определяет тип создаваемого элемента. У вновь созданного контакта большое число свойств и методов и, конечно же, есть поля (свойства), соответствующие полям записи Person, так что мне осталось только передать значения полей из записи объекту контакт. Чтобы новый контакт был добавлен в папку Contacts приложения Outlook, как я уже говорил, достаточно было выполнить метод Save.

Рассмотрим теперь работу еще с одним объектом Outlook класса AppointmentItem. Этот объект связан с календарем - папкой Calendar. При планировании рабочего дня возникает необходимость назначать встречи, совещания - эти и другие события делового дня могут быть одноразовыми, запланированными на определенный день и час. Но кроме таких событий могут быть события регулярные, появляющиеся с определенной цикличностью, например, раз в неделю или ежегодно. Каждому назначению встречи, каждому регулярному событию соответствует объект AppointmentItem, с которым можно работать программно.

Когда создается новый контакт в папке Contacts, то автоматически создается и объект AppointmentItem, задающий такое ежегодное событие, связанное с контактом, как день рождения контакта. Это событие может быть включено или выключено. Поэтому для того, чтобы для каждого добавляемого контакта включалось соответствующее событие с предварительным уведомлением о предстоящем дне рождения контакта, необходимо найти автоматически созданный объект AppointmentItem и установить нужным образом значения его свойств. Эта задача и решается во второй части процедуры WriteToContact. Чтобы найти нужный нам объект AppointmentItem, являющийся элементом папки Calendar, предварительно необходимо добраться до самой папки. Я уже говорил, что для этих целей используется объект olNameSpace, который, если Вы помните, был введен среди глобальных объектов наряду с объектом myOl, описывающим приложение Outlook. Получив папку Calendar, я в ее коллекции элементов Items, выбираю последний элемент, поскольку понимаю, что это и есть нужный мне объект AppointmentItem, только что созданный при сохранении нового контакта. Конечно, можно считать, что мне повезло, что я таким косвенным образом знаю индекс нужного мне элемента в коллекции. Этот прием не всегда может быть использован. Так что всегда остается вопрос, как установить индекс или имя элемента в коллекции items папки Calendar и других папок, но рассмотрение этой более общей ситуации оставим на будущее.

По существу, в данной процедуре мне понадобилось установить значения только двух свойств объекта AppointmentItem, остальные определены при автоматическом создании этого объекта. Я включил напоминание о предстоящем событии и установил, что первое напоминание должно появиться за сутки (1440 минут) до наступления самого события.

Нам осталось посмотреть на ряд снимков экрана, полученных по ходу работы со справочником "Кто есть кто" в процессе переноса данных из текстовой базы данных в базу данных, описывающих контакты приложения Outlook. Вот как выглядит папка Contacts с добавленными контактами:

Контакты, добавленные программно, в результате работы нашей процедуры, можно распознать на рисунке, благодаря значку вложенного сообщения (скрепка), который сопровождает добавляемые контакты. Хочу обратить Ваше внимание, что при программном добавлении не проводится автоматическая проверка на существование добавляемого контакта в папке Contacts, поэтому могут появляться несколько копий одного и тоже контакта, что можно видеть на рисунке. Если щелкнуть по контакту в папке Contacts, то появится окно с отображением его свойств. Взгляните, как выглядит это окно для одного из добавленных контактов:

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

Давайте взглянем еще, как выглядит запись о дне рождения контакта, добавляемая в соответствующий день календаря, открываемого папкой Calendar приложения Outlook:

Ну и, чтобы завершить картину, приведу еще один снимок, в котором показано, как появляются сообщения, уведомляющие о предстоящем событии. Заметьте, что поскольку информация о данном контакте в папке Contacts была продублирована, то появились и два окна выдачи соответствующего сообщения:

На этом я завершу описание примера, в котором рассмотрено взаимодействие двух приложений - Word и Outlook. На этом я закончу и данную лекцию.