Хронометраж

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

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

Листинг 2.23.

(html, txt)

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

Таблица 2.1. Временной профиль работы макроса - конструкции For Each и Select

N эксперимента123

TAll - Общее время работы	2,187	1,96	1,95
TForEach - Время работы внешнего цикла для конструкции For Each	2,078	1,86	1,86
TSelect - Время работы конструкции Select -Case	1,01	0,80	1,08
TIndex1 - Время1 работы функции Asc	0	0,008	0,007
TIndex2 - Время2 работы функции Asc	0	0	0
TSym1 - Время1 работы функции Mid	0,0078	0,031	0,04
TSym2 - Время2 работы функции Mid	0	0	0

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

Основное время работы данной процедуры, примерно 2 секунды, затрачивается на организацию цикла (конструкцию For Each) и организацию разбора случаев (конструкцию Select - Case).На организацию цикла и разбор случаев тратится примерно равное время, чуть более секунды на организацию цикла и чуть менее секунды на организацию разбора случаев.Внутренние операторы конструкции 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

Листинг 2.24.

(html, txt)

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

Таблица 2.2. Временной профиль работы макроса - конструкции For Each и If-Then-ElseN эксперимента123

TAll - Общее время работы	2,06	2,02	1,98
TForEach - Время работы внешнего цикла для конструкции For Each	1,97	1,93	1,89
TSelect - Время работы конструкции If-Then-Else	0,97	0,96	0,89
TIndex1 - Время1 работы функции Asc	0,015	0,02	0,007
TIndex2 - Время2 работы функции Asc	0	0	0
TSym1 - Время1 работы функции Mid	0,046	0,051	0,02
TSym2 - Время2 работы функции Mid	0	0	0

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

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

Листинг 2.25.

(html, txt)

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

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

Листинг 2.26.

(html, txt)



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

Таблица 2.2. Временной профиль работы макроса - конструкции For I =1 To N и SelectN эксперимента123

TAll - Общее время работы	106,53	113,37	115,84
TForEach - Время работы внешнего цикла для конструкции For Each	106,44	113,27	115,74
TSelect - Время работы конструкции Select -Case	0,140	0,148	0,187
TIndex1 - Время1 работы функции Asc	0,02	0,03	0,015
TIndex2 - Время2 работы функции Asc	0	0	0
TSym1 - Время1 работы функции Mid	0,078	0,015	0,054
TSym2 - Время2 работы функции Mid	0	0	0

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

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

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

увеличить изображение
Рис. 2.1.  Инструментальная панель Buffers с кнопками

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

Копирование объекта

До сих пор я говорил о копировании выделенного текста. И делал я это потому, что копирование текста это наиболее типичная задача, возникающая при работе с документом Word. Однако понятно, что реально в документе Word выделяется не текст, а некоторая область документа, - объект Range, если говорить в терминах объектов. Я напомню, что объект Range может быть устроен столь же сложно, как и сам документ, и, наряду с текстом, содержать самые разные компоненты, например, рисунки. Стандартная реализация Copy - Paste фактически работает именно с объектом Range. Давайте напишем и мы такую же реализацию. Вот как задается буфер и макросы в подобной реализации:

'Буфер, позволяющий сохранять объект Public ObjectBuffer As Range

Public Sub CopyObject() 'Этот макрос копирует выделенный объект в буфер Set ObjectBuffer = Selection.Range End Sub

Public Sub PasteObject() 'Этот макрос выполняет операцию, обратную копированию. 'Объект из буфера вставляется в точку, заданную курсором. 'Поскольку объект может быть сложным и содержать, например, 'рисунки, то используется техника копирования через стандартный буфер! ObjectBuffer.Copy Selection.PasteSpecial

End Sub

Листинг 2.4.

(html, txt)

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

Копирование текста

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

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

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

'Текстовый буфер задается обычной строкой Public TextBuffer As String

Public Sub CopyText() 'Этот макрос копирует выделенный текст в буфер TextBuffer = Selection.Text End Sub

Public Sub PasteText() 'Этот макрос выполняет операцию, обратную копированию 'Текст из буфера вставляется в точку, заданную курсором Selection.Text = TextBuffer End Sub

Листинг 2.1.

(html, txt)

Как видите, буфер задается обычной текстовой переменной VBA. Выделенный текст задается свойством Text объекта Selection. Точка вставки, заданная курсором, также представляется объектом Selection.

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

Копирование текста и шрифта

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

'Буфер, сохраняющий текст и шрифт Public Type TextAndFont BufText As String BufFont As Font End Type

Public TaFBuffer As TextAndFont

Листинг 2.2.

(html, txt)

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

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

Public Sub CopyTextAndFont() 'Этот макрос копирует выделенный текст и шрифт в буфер Set TaFBuffer.BufFont = Selection.Font TaFBuffer.BufText = Selection.Text End Sub

Public Sub PasteTextAndFont() 'Этот макрос выполняет операцию, обратную копированию

'К сожалению, такое присваивание свойства Font 'для объекта Selection не проходит?! 'Selection.Font = TaFBuffer.BufFont 'Но можно присвоить свойства объекту Font Selection.Font.Name = TaFBuffer.BufFont.Name Selection.Font.Bold = TaFBuffer.BufFont.Bold Selection.Font.Italic = TaFBuffer.BufFont.Italic Selection.Font.Size = TaFBuffer.BufFont.Size 'Текст из буфера с указанными параметрами шрифта 'вставляется в точку, заданную курсором. Selection.Text = TaFBuffer.BufText End Sub

Листинг 2.3.

(html, txt)

Первый из этих макросов не нуждается в особых комментариях. Объект Selection имеет наряду со свойством Text и свойство Font, возвращающее объект данного класса. Эти свойства и передаются в поля переменной, определяющей наш буфер. Казалось бы, что второй макрос должен быть симметричным, поскольку необходимо выполнить такое же присваивание, но в другую сторону. Однако объекты Range и Selection обладают одной особенностью, - их свойству Font нельзя присвоить объект класса Font. Можно, однако, задать характеристики этого объекта, чем я и воспользовался.

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

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

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

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

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

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

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

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

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

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

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

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

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

Замечу, что для решения этой задачи в 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



Листинг 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.

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

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

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

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

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

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

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

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

Листинг 2.5.

(html, txt)

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

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

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

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

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

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

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

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

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

Прежде всего, используется синтаксическая структура документа Word. Известно, что текст любого документа Word структурирован, - в документе можно выделить поддокументы, разделы, абзацы, предложения, слова.Другой общий способ структуризации состоит в разделении текста на части, главы, параграфы, подпараграфы за счет введения стилей и, прежде всего, заголовков соответствующего уровня. Очень часто создается специальная совокупность стилей для придания нужной структуры текстовому документу. Третий способ организации данных справочника состоит в использовании специальных ключевых слов для выделения тех или иных разделов и приданию документу тем самым нужной структуры.

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

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

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

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

Прежде всего, используется синтаксическая структура документа Word. Известно, что текст любого документа Word структурирован, - в документе можно выделить поддокументы, разделы, абзацы, предложения, слова.Другой общий способ структуризации состоит в разделении текста на части, главы, параграфы, подпараграфы за счет введения стилей и, прежде всего, заголовков соответствующего уровня. Очень часто создается специальная совокупность стилей для придания нужной структуры текстовому документу. Третий способ организации данных справочника состоит в использовании специальных ключевых слов для выделения тех или иных разделов и приданию документу тем самым нужной структуры.

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

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

Должность,Дату рождения,Адрес,Адрес электронной почты,Телефон,Факс,Увлечения,Разное.

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

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

АГАМИРЗЯН Игорь Рубенович

ЗАО "Майкрософт", руководитель отдела.

Отвечает за проектную работу с крупными заказчиками.

Родился 21 марта 1957 года в Ленинграде. В 1979 году окончил мехмат ЛГУ, до 1992 года работал в АН СССР, одновременно до 1995 года преподавал в СПб Техническом университете, кандидат физико-математических наук, старший научный сотрудник, доцент. В 1991 году принял участие в создании компании "АстроСофт" и до 1995 года являлся техническим директором этой компании.



В 1993 году начал сотрудничать с Microsoft, с 1995 года является штатным сотрудником Microsoft Consulting Services. В 1996 году возглавляет российское отделение MCS. Имеет статус "Microsoft Certified Systems Engineer". Неоднократно попадал в различные опросы и рейтинги, в том числе в Дейтор top100 '94, "Кто есть кто в компьютерном мире Петербурга" 95 и 96 года. С 1993 года входит в Marquis "Who's Who in Science and Engineering" и "Who's Who in the World".

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

Основным своим достижением в компьютерном бизнесе считает участие в создании питерской фирмы "АстроСофт", оказавшейся на удивление живучей.

Любимый способ проведения досуга отсутствует в связи с отсутствием досуга, как такового.

Свободно владеет английским языком и может изъясняться по-русски в разговорах с клиентами.

Адрес: 125190, Москва, Чапаевский пер., 14, Microsoft.

Тел.: (095) 967-85-85

Факс: (095) 967-85-00

e-mail: IgorA@Microsoft.com

АЛЬТШУЛЕР Игорь Григорьевич

Фирма "Куб" (Н.Новгород), вице-президент, Первая Нижегородская гильдия профессиональных консультантов, вице-президент, еженедельник PC Week/RE, обозреватель, еженедельник "Биржа" (Н.Новгород), обозреватель.

Родился 28 сентября 1954 года в Горьком. По гороскопу - Весы, старается соответствовать.

В 1971 году окончил с отличием мехмат Горьковского университета. Работал прикладным и системным программистом, был начальником отдела автоматизации крупного проектного института. Имеет авторское свидетельство на изобретение, сертификат фирмы McDonnell Douglas (США). 1991-1993 гг. - директор по развитию АО "Диалог-Н.Новгород", 1993-1995 гг. - советник президента страховой компании "Утес", с 1995 года - независимый консультант и аналитик. В 1994 году проходил стажировку в США. Автор и соавтор нескольких популярных книг, связанных с обработкой текстов, электронными таблицами, применением компьютеров в экономике, Интернетом.



Основными достижениями последних лет считает "Консалтинг-бал", итоги которого были опубликованы в PC Week/RE, ряд "круглых столов".

Увлечение - стихи (пишет, читает "про себя" чужие и свои, читает вслух свои и чужие).

Досуг проводит на диване, там же и работает, так что понятия работы и досуга давно переплелись. Дочка - девятиклассница хочет стать журналистом, сын - семиклассник еще не решил, кем он хочет стать.

Умеет читать и писать по-английски, может поддержать светскую беседу. В качестве синхронного переводчика смотрится много хуже.

Тел.: (831-2) 94-20-55

Адрес: 603123, Нижний Новгород, А-123, а/я 176, Альтшулеру И.Г.

e-mail: altsh@kis.ru

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

on_load_lecture()

Дальше »

  Если Вы заметили ошибку - сообщите нам.   Страницы:

« |

1

|

2

|

3

|

4

|

5

|

6

|

7

|

вопросы | »

|

для печати и PDA

Курсы | Учебные программы | Учебники | Новости | Форум | Помощь Телефон: +7 (495) 253-9312, 253-9313, факс: +7 (495) 253-9310, email: info@intuit.ru © 2003-2007, INTUIT.ru::Интернет-Университет Информационных Технологий - дистанционное образование

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

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

Должность,Дату рождения,Адрес,Адрес электронной почты,Телефон,Факс,Увлечения,Разное.

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

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

АГАМИРЗЯН Игорь Рубенович

ЗАО "Майкрософт", руководитель отдела.

Отвечает за проектную работу с крупными заказчиками.

Родился 21 марта 1957 года в Ленинграде. В 1979 году окончил мехмат ЛГУ, до 1992 года работал в АН СССР, одновременно до 1995 года преподавал в СПб Техническом университете, кандидат физико-математических наук, старший научный сотрудник, доцент. В 1991 году принял участие в создании компании "АстроСофт" и до 1995 года являлся техническим директором этой компании.



В 1993 году начал сотрудничать с Microsoft, с 1995 года является штатным сотрудником Microsoft Consulting Services. В 1996 году возглавляет российское отделение MCS. Имеет статус "Microsoft Certified Systems Engineer". Неоднократно попадал в различные опросы и рейтинги, в том числе в Дейтор top100 '94, "Кто есть кто в компьютерном мире Петербурга" 95 и 96 года. С 1993 года входит в Marquis "Who's Who in Science and Engineering" и "Who's Who in the World".

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

Основным своим достижением в компьютерном бизнесе считает участие в создании питерской фирмы "АстроСофт", оказавшейся на удивление живучей.

Любимый способ проведения досуга отсутствует в связи с отсутствием досуга, как такового.

Свободно владеет английским языком и может изъясняться по-русски в разговорах с клиентами.

Адрес: 125190, Москва, Чапаевский пер., 14, Microsoft.

Тел.: (095) 967-85-85

Факс: (095) 967-85-00

e-mail: IgorA@Microsoft.com

АЛЬТШУЛЕР Игорь Григорьевич

Фирма "Куб" (Н.Новгород), вице-президент, Первая Нижегородская гильдия профессиональных консультантов, вице-президент, еженедельник PC Week/RE, обозреватель, еженедельник "Биржа" (Н.Новгород), обозреватель.

Родился 28 сентября 1954 года в Горьком. По гороскопу - Весы, старается соответствовать.

В 1971 году окончил с отличием мехмат Горьковского университета. Работал прикладным и системным программистом, был начальником отдела автоматизации крупного проектного института. Имеет авторское свидетельство на изобретение, сертификат фирмы McDonnell Douglas (США). 1991-1993 гг. - директор по развитию АО "Диалог-Н.Новгород", 1993-1995 гг. - советник президента страховой компании "Утес", с 1995 года - независимый консультант и аналитик. В 1994 году проходил стажировку в США. Автор и соавтор нескольких популярных книг, связанных с обработкой текстов, электронными таблицами, применением компьютеров в экономике, Интернетом.



Основными достижениями последних лет считает "Консалтинг-бал", итоги которого были опубликованы в PC Week/RE, ряд "круглых столов".

Увлечение - стихи (пишет, читает "про себя" чужие и свои, читает вслух свои и чужие).

Досуг проводит на диване, там же и работает, так что понятия работы и досуга давно переплелись. Дочка - девятиклассница хочет стать журналистом, сын - семиклассник еще не решил, кем он хочет стать.

Умеет читать и писать по-английски, может поддержать светскую беседу. В качестве синхронного переводчика смотрится много хуже.

Тел.: (831-2) 94-20-55

Адрес: 603123, Нижний Новгород, А-123, а/я 176, Альтшулеру И.Г.

e-mail: altsh@kis.ru

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

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

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

Составление списка персон (фамилия, имя, отчество) и предъявление этого списка пользователю.Составление списка персон, выбранных пользователем.Для каждой выбранной персоны получение информации, требуемой для контакта в Outlook и создание очередного контакта. Одновременно с этим создание события, связанного с контактом.

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

Листинг 2.27.

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

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



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

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

Листинг 2.28.

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



Листинг 2.29.

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

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


Рис. 2.4.  Форма, содержащая список персон справочника "Кто есть кто"

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

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

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



Листинг 2.30.

Здесь, как бычно, в цикле по всем персонам анализируется множественный выбор пользователя, и фамилии выбранных персон добавляются в коллекцию 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

Листинг 2.31.

Внешний цикл организован по элементам коллекции 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



Листинг 2.32.

В этой процедуре заполняются поля переменной 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

Листинг 2.33.

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

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

Листинг 2.34.

В этой процедуре я не старался исправить все возможные ошибки, скорее я проверял корректность той или иной комбинации, используя для проверки функцию 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

Листинг 2.35.

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


увеличить изображение
Рис. 2.5.  Папка Контакты с добавленными контактами

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


Рис. 2.6.  Окно свойств добавленного контакта

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


Рис. 2.7.  Окно уведомления о дне рождения контакта

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


увеличить изображение
Рис. 2.8.  Окно календаря Outlook с показом события, связанного с днем рождения контакта

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


увеличить изображение
Рис. 2.9.  Предупреждающие сообщения о предстоящем событии.

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

© 2003-2007 INTUIT.ru. Все права защищены.

Текстовый буфер задается обычной строкой

' Текстовый буфер задается обычной строкой Public TextBuffer As String Public Sub CopyText() 'Этот макрос копирует выделенный текст в буфер TextBuffer = Selection.Text End Sub Public Sub PasteText() 'Этот макрос выполняет операцию, обратную копированию 'Текст из буфера вставляется в точку, заданную курсором Selection.Text = TextBuffer End Sub

Листинг 2.1.

Закрыть окно

и шрифт Public Type TextAndFont

'Буфер, сохраняющий текст и шрифт Public Type TextAndFont BufText As String BufFont As Font End Type Public TaFBuffer As TextAndFont

Листинг 2.2.

Закрыть окно

Этот макрос копирует выделенный текст

Public Sub CopyTextAndFont() ' Этот макрос копирует выделенный текст и шрифт в буфер Set TaFBuffer.BufFont = Selection.Font TaFBuffer.BufText = Selection.Text End Sub Public Sub PasteTextAndFont() 'Этот макрос выполняет операцию, обратную копированию 'К сожалению, такое присваивание свойства Font 'для объекта Selection не проходит?! 'Selection.Font = TaFBuffer.BufFont 'Но можно присвоить свойства объекту Font Selection.Font.Name = TaFBuffer.BufFont.Name Selection.Font.Bold = TaFBuffer.BufFont.Bold Selection.Font.Italic = TaFBuffer.BufFont.Italic Selection.Font.Size = TaFBuffer.BufFont.Size 'Текст из буфера с указанными параметрами шрифта 'вставляется в точку, заданную курсором. Selection.Text = TaFBuffer.BufText End Sub

Листинг 2.3.

Закрыть окно

позволяющий сохранять объект Public ObjectBuffer

'Буфер, позволяющий сохранять объект Public ObjectBuffer As Range Public Sub CopyObject() 'Этот макрос копирует выделенный объект в буфер Set ObjectBuffer = Selection.Range End Sub Public Sub PasteObject() 'Этот макрос выполняет операцию, обратную копированию. 'Объект из буфера вставляется в точку, заданную курсором. 'Поскольку объект может быть сложным и содержать, например, 'рисунки, то используется техника копирования через стандартный буфер! ObjectBuffer.Copy Selection.PasteSpecial End Sub

Листинг 2.4.

Закрыть окно

Множественный буфер можно задать массивом

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

Листинг 2.5.

Закрыть окно

Этот макрос копирует выделенный объект

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

Листинг 2.6.

Закрыть окно

Dim Txt As String NumElem

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

Листинг 2.7.

Закрыть окно

с элементами буфера

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

Листинг 2.8.

Закрыть окно

в точку, заданную курсором Dim

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

Листинг 2.9.

Закрыть окно

Dim RowIndex As Integer Dim

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

Листинг 2.10.

Закрыть окно

Удаляет элементы из списка For

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

Листинг 2.11.

Закрыть окно

PanelName As String) As Boolean

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

Листинг 2.12.

Закрыть окно

Этот макрос копирует выделенный объект

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

Листинг 2.13.

Закрыть окно

DropDown ComboBox Dim Ctrl As

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

Листинг 2.14.

Закрыть окно

и DropDown списка на панели

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

Листинг 2.15.

Закрыть окно

Вставка всех элементов из буфера

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

Листинг 2.16.

Закрыть окно

For Each Sym In Text

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

Листинг 2.17.

Закрыть окно

Dim Sym As String, Sym1

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

Листинг 2.18.

Закрыть окно

Dim Sym As String, Sym1

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.

Закрыть окно

To 32) As String

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.

Закрыть окно

Эта процедура преобразует выделенный программный

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.

Закрыть окно

Dim Sym As String, Sym1

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.

Закрыть окно

Dim Sym As String, Sym1

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

Листинг 2.23.

Закрыть окно

End Select на конструкцию: If

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

Листинг 2.24.

Закрыть окно

For Each Sym1 In

For Each Sym1 In Selection.Characters

Листинг 2.25.

Закрыть окно

For i = 1 To Selection.Characters

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

Листинг 2.26.

Закрыть окно

и его компоненты Public myOl

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

Листинг 2.27.

Закрыть окно

в базу данных Контакты приложения

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

Листинг 2.28.

Закрыть окно

Эта процедура формирует список личностей

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

Листинг 2.29.

Закрыть окно

Dim intLoop As Integer, intSelect

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

Листинг 2.30.

Закрыть окно

Выделение записи Dim par As

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

Листинг 2.31.

Закрыть окно

и отмеченной записью Dim pers

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

Листинг 2.32.

Закрыть окно

ran As Range) As String

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

Листинг 2.33.

Закрыть окно

False ?IsDate

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

Листинг 2.34.

Закрыть окно

о нем Dim newContact As

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

Листинг 2.35.

Закрыть окно

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

Чтобы эффективно работать с текстовыми документами, необходимо хорошо знать объекты Word, описанные в предыдущей лекции. Без знания основных коллекций, задающих структуру документа, - абзацев, предложений, слов, символов, без знания объектов Range и Selection, не обойтись. С другой стороны необходимо владение встроенными функциями VBA для работы со строковыми переменными. Умение работы с объектами Word и функциями VBA позволяет достаточно просто решать самые разнообразные задачи, возникающие в ходе работы с текстовыми документами. В предыдущей лекции, где я рассматривал объекты Word, я приводил большое число примеров, иллюстрирующих работу с теми или иными объектами. Но там рассмотрение шло от "объектов", теперь же я хочу идти от "задач", которые могут возникать при работе с текстовыми документами. Давайте перейдем к рассмотрению некоторых примеров.

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

Текстовый документ - один из основных видов документов, наиболее привычный для обычного пользователя. Стандартные возможности Word при работе с такими документами многогранны, тем не менее, в каждой конкретной ситуации возникает необходимость выполнять специфические операции над тем или иным документом. Программная работа с документами Word хотя и проста, но требует некоторых навыков. Приведу фразу из письма одного из читателей, обратившегося на днях ко мне с просьбой помочь ему в решении задачи, возникшей перед ним при работе с документом Word. Он пишет:

Ни по одной книжке по VBA я даже близко не могу понять, как писать макросы для обработки текстовых документов

Конечно, опытные программисты не примут эту фразу всерьез.

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

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

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

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

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

Рис. 2.2.  Форма, отображающая элементы множественного буфера

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

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

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

Листинг 2.6.

(html, txt)

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

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

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

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

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

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

Рис. 2.3.  Панель MultBufferPanel с кнопкой типа DropDown

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

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

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

Рис. 2.2.  Форма, отображающая элементы множественного буфера

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

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

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

Листинг 2.6.

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

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

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

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

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

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

Рис. 2.3.  Панель MultBufferPanel с кнопкой типа DropDown

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

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

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

Листинг 2.7.

(html, txt)

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

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



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

Листинг 2.8.

(html, txt)

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

Листинг 2.9.

(html, txt)

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

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

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



Листинг 2.10.

(html, txt)

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

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

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

Листинг 2.11.

(html, txt)

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

on_load_lecture()

Дальше »

  Если Вы заметили ошибку - сообщите нам.   Страницы:

« |

1

|

2

|

3

|

4

|

5

|

6

|

7

|

вопросы | »

|

для печати и PDA

Курсы | Учебные программы | Учебники | Новости | Форум | Помощь Телефон: +7 (495) 253-9312, 253-9313, факс: +7 (495) 253-9310, email: info@intuit.ru © 2003-2007, INTUIT.ru::Интернет-Университет Информационных Технологий - дистанционное образование

Листинг 2.12.

(html, txt)

Основной здесь является процедура 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

Листинг 2.13.

(html, txt)

Заметьте, в отличие от макроса 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

Листинг 2.14.

(html, txt)

Обратите внимание, я использую свойство 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

Листинг 2.15.

(html, txt)

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

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

Листинг 2.16.

(html, txt)

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



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

Листинг 2.7.

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

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



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

Листинг 2.8.

Заметьте, что при открытии формы возникает событие 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

Листинг 2.9.

Несколько слов о том, как реализована вставка. Вначале я определяю, какой элемент списка выбран, что позволяет определить индекс элемента буфера (коллекции), который должен быть вставлен в позицию курсора. На этом этапе также приходится анализировать тип вставляемого объекта, поскольку объекты 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

Листинг 2.10.

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

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

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

Листинг 2.11.

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



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



Листинг 2.12.

Основной здесь является процедура 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

Листинг 2.13.

Заметьте, в отличие от макроса 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

Листинг 2.14.

Обратите внимание, я использую свойство 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

Листинг 2.15.

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

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

Листинг 2.16.

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

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

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

Вариации на тему "буфера"

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

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

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

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

Прежде чем приводить реализацию частных случаев скажем несколько слов об общей схеме решения задачи трансляции. Для ее решения достаточно построить два массива одинаковой длины 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

Листинг 2.17.

(html, txt)

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

---

---