Этюды для программистов Microsoft Word

Home ] Up ] Этюд 1.1. Подгонка размера текста ] Этюд 1.2. Изменение регистра символов ] Этюд 1.3. Поиск и раскраска гиперссылок ] Этюд 1.4. Стили ] Этюд 1.5. Вставка форматированного текста ] Этюд 1.6. Вычисление высоты текста. ] Этюд 1.7. Форматирование заголовка. ]


Этюд 1.3 Поиск и раскраска гиперссылок

A hyperlink, or simply a link, is a reference in a hypertext document to another document or other resource. It is similar to a citation in literature. Combined with a data network and suitable access protocol, it can be used to fetch the resource referenced. This can then be saved, viewed, or displayed as part of the referencing document.

The most common type of hyperlink is the URL used in the World Wide Web. A web browser usually displays a hyperlink in some distinguishing way, e.g. in a different colour, font or style. ...

Hyperlinks were first described in 1945 in the landmark paper As We May Think, as well in the widely-known project Xanadu starting in the 1960s.

http://www.websters-online-dictionary.org/definition/hyperlink

Задание. Диалог "Find and Replace". Объекты Find и Replacement.

Удобная навигация по документу является жизненно необходимым умением каждого текстового процессора. Этим умением, без всяких сомнений, должен владеть каждый пользователь. Для документов большого размера (десятки и сотни страниц) удобство навигации становится особенно актуальным. К инструментам навигации относится возможность перемещения "Go To" по разным объектам документа (закладки, страницы, секции, строки, параграфы, картинки, таблицы, поля, элементы оглавления и другие) и, конечно, все возможности поиска и замены, включая возможность задавать в критериях поиска и замены атрибуты форматирования.

Если Вы не знакомы с объектами Find и Replacement, то сейчас самое подходящее время, чтобы их изучить. С помощью этих объектов реализована функциональность диалога "Find and Replace", который тоже рассматривается в Приложении. [Читать!]

 

Задание. Диалог "Edit Hyperlink". Объект Hyperlink и коллекция Hyperlinks.

Представить полезный текст без гиперссылок сегодня практически невозможно. Используете ли Вы все  возможности Microsoft Word по работе с гиперссылками? Если нет, то в Приложении перечислены все возможности диалога "Edit Hyperlink" , а также свойства и методы объекта Hyperlink и коллекции Hyperlinks, с помощью которых в Microsoft Word реализована работа с гиперссылками. [Читать!]

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

 

Гиперссылки представляют собой объекты, обладающие некоторой специальной функциональностью. Текст, отформатированный с помощью стиля Hyperlink (обычно это синий цвет с подчеркиванием), выглядит как гиперссылка, но гиперссылкой не является. Это просто подчеркнутый текст синего цвета. Видимая часть гиперссылки (отображаемый текст, TextToDisplay) является обычным текстом, отформатированным с помощью стиля с именем Hyperlink. Отображаемый текст не обязательно совпадает с адресом гиперссылки, который представляет собой адрес страницы в сети, имя файла документа или адрес электронной почты.

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

Форматирование текста с использованием стиля Hyperlink не превращает отформатированный текст в гиперссылку. Это просто подчеркнутый текст синего цвета.

Ресурсы

Шаблон "AhTextHyperlinks.dot", 28 Кб, формат ZIP,  [скачать].

Функциональная спецификация

Задача

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

SOMETHING@DOMAIN.HOST

или

mailto:SOMETHING@DOMAIN.HOST

и превратить их в адреса электронной почты.
Необходимо также найти все вхождения строк типа

SOMETHING.DOMAIN.HOST

или

http://SOMETHING.DOMAIN.HOST

и превратить в работающие гиперссылки. В этом этюде создание гиперссылок будет для краткости называться "раскраской".

Термин "раскраска" в этом этюде означает именно создание объектов типа Hyperlink.

Необходимо создать шаблон "AhTextHyperlinks.dot", в котором будут размещены макросы для создания (поиска и "раскраски") и удаления гиперссылок и панель инструментов "AhTextHyperlinks", предоставляющая доступ к операциям создания и удаления гиперссылок.

Панель инструментов "AhTextHyperlinks"

Панель инструментов "AhTextHyperlinks" имеет следующий вид.

Панель инструментов "AhTextHyperlinks"предоставляет доступ к следующим функциям.

Кнопка панели

Макрос

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

Help

AhHyperlinksHelp

Краткая подсказка по кнопкам панели инструментов.

Hyperlinks

AhFindAndPaintHyperLinks

Поиск и "раскраска" гиперссылок.

E-Mails

AhFindAndPaintEMails

Поиск и "раскраска" адресов e-mail.

All Links

AhFindAndPaintAllLinks

Поиск и "раскраска" гиперссылок и адресов e-mail.

Delete

AhHyperlinksDelete

Удаление всех гиперссылок из текущего документа.

 

При использовании кнопки "Delete" удаляются ВСЕ гиперссылки из текущего документа, включая те, которые, возможно, были в документе до использования команд поиска и "раскраски".

Краткая подсказка по кнопкам панели инструментов

Краткая подсказка по кнопкам панели инструментов имеет следующий вид.

Поиск и "раскраска" гиперссылок

Пример текста исходного документа ДО применения команды поиска и раскраски гиперссылок. Гиперссылки представляют собой обычный текст.

Пример текста исходного документа ПОСЛЕ применения команды поиска и раскраски гиперссылок. Гиперссылки уже раскрашены. Адреса электронной почты всё ещё представляют собой обычный текст.

Поиск и "раскраска" адресов e-mail

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

Удаление всех гиперссылок из текущего документа

При нажатии кнопки "Delete" (ввиду возможности потери важной информации) программа должна запрашивать подтверждение пользователя.

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

Гиперссылки удаляются именно как объекты коллекции Microsoft Word. Видимый текст гиперссылки (иногда совпадающий с адресом, а иногда не совпадающий) остается на своём месте. Для гиперссылок, у которых отображаемый текст не совпадает с адресом, информация об адресе теряетcя.  Будьте осторожны!

Реализация - шаблон "AhTextHyperlinks.dot"

В шаблоне "AhTextHyperlinks.dot" реализованы операции поиска, создания и удаления гиперссылок. Панель инструментов "AhTextHyperlinks" предоставляет простой интерфейс к операциям создания (поиска и "раскраски") и удаления гиперсссылок.

Модуль AhTextHyperlinks

'
' File AhTextHyperlinks.dot|AhTextHyperlinks
'
' Etudes for Microsoft Word Programmers.
' Etude
1.3. Finding and Painting Hyperlinks.
'
' First published on http://www.transcriber.ru
'
' © 2000-2007. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Variables
'
Private iSelStart, iSelEnd As Long

Константы

'
' Constants
'
Private Const cStrAhTextHyperlinksHelp As String = _
"Etudes for Microsoft Word Programmers." & vbCrLf & _
"Etude
1.3. Finding and Painting Hyperlinks." & vbCrLf & _
"http://www.transcriber.ru" & vbCrLf & vbCrLf & _
"Template AhTextHyperlinks.dot - working with hyperlinks." & vbCrLf & vbCrLf & _
"Hyperlinks - find and paint hyperlinks" & vbCrLf & _
"E-Mails - find and paint e-mail addresses" & vbCrLf & _
"All links - find and paint both hyperlinks and e-mail addresses" & vbCrLf & _
"Delete - clean Hyperlinks collection." & vbCrLf & vbCrLf & _
"All functions effect active document." & vbCrLf & _
"Paint means add to Hyperlinks collection."
Private Const cStrAhTextHyperlinksConfirmDelete As String = _
 "You are about to delete all hyperlinks and e-mail addresses" & vbCrLf & _
 "from the current document. Some information could be lost." & vbCrLf & vbCrLf & _
 "Press 'Yes' button to continue with deletion. Continue?"

Префиксы

'
' Prefixes
'
Private Const cStrPrefixMail = "mailto:"
Private Const cStrPrefixHttp = "http://"
Private Const cStrPrefixFtp = "ftp://"

Шаблоны поиска

'
' Regular expressions
'
Private Const cStrRegExpMail = _
"([A-Za-z0-9]{3,31})[\@]([A-Za-z0-9]{2,31})[.]([A-Za-z0-9]{2,31})"
Private Const cStrRegExpHttp = _
"([A-Za-z0-9]{3,31})[.]([A-Za-z0-9]{2,31})[.]([A-Za-z0-9/]{2,31})"

Процедура AhHyperlinksHelp

'
' AhHyperlinksHelp
'
Sub AhHyperlinksHelp()
    MsgBox cStrAhTextHyperlinksHelp
End Sub

Процедура AhHyperlinksDelete

'
' AhHyperlinksDelete
'
Sub AhHyperlinksDelete()
If Documents.Count = 0 Then Exit Sub
    If vbYes <> MsgBox(cStrAhTextHyperlinksConfirmDelete, vbYesNo) Then Exit Sub
   
    Dim dwLink, dwLinkCount As Long
    dwLinkCount = ActiveDocument.Hyperlinks.Count
    For dwLink = 1 To dwLinkCount
        ActiveDocument.Hyperlinks(1).Delete
    Next dwLink
End Sub

Функция AhHyperlinkExists

'
' AhHyperlinkExists
'
Private Function AhHyperlinkExists(ByVal strLinkTextToDisplay As String) As Boolean
    AhHyperlinkExists = False
    If Documents.Count = 0 Then Exit Function
    On Error GoTo ErrorLabel
    Dim hl As Hyperlink
    For Each hl In ActiveDocument.Hyperlinks
        If hl.TextToDisplay = strLinkTextToDisplay Then
            AhHyperlinkExists = True
            Exit For
        End If
    Next hl
    Exit Function
ErrorLabel:
End Function

Функция AhHyperlinkRangeExists

'
' AhHyperlinkRangeExists
'
Private Function AhHyperlinkRangeExists(ByVal rng As Range) As Boolean
    AhHyperlinkRangeExists = False
    If Documents.Count = 0 Then Exit Function
    On Error GoTo ErrorLabel
    Dim hl As Hyperlink
    For Each hl In ActiveDocument.Hyperlinks
        If hl.Range = rng Then
            AhHyperlinkRangeExists = True
            Exit For
        End If
    Next hl
    Exit Function
ErrorLabel:
End Function

Процедура AhHyperlinksDump

'
' AhHyperlinksDump
'
Private Sub AhHyperlinksDump()
Dim cnt As Long
Dim cntTotal As Long
Dim hl As Hyperlink
If Documents.Count = 0 Then Exit Sub
    cntTotal = ActiveDocument.Hyperlinks.Count
    For cnt = 1 To cntTotal
        Set hl = ActiveDocument.Hyperlinks(cnt)
        Debug.Print "<" & hl.TextToDisplay & "> = [" & hl.Address & "]"
    Next cnt
End Sub

Функция AhHyperlinkFindAndAdd

'
' AhHyperlinkFindAndAdd
'
Private Function AhHyperlinkFindAndAdd(ByVal strPrefix As String, ByVal strFindPattern As String) As Boolean
    AhHyperlinkFindAndAdd = False
    If Documents.Count = 0 Then Exit Function
   
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = strFindPattern
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   
    If Selection.Find.Execute Then
        Dim strLinkText As String
        strLinkText = Selection.Range.Text
        Dim bExists As Boolean
        bExists = AhHyperlinkRangeExists(Selection.Range)
        Debug.Print "<" & strLinkText & "> exists = " & bExists
        AhHyperlinkFindAndAdd = True
           
        Dim strLinkFull As String
        strLinkFull = strPrefix + strLinkText
        On Error Resume Next
        ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, _
            Address:=strLinkFull, SubAddress:="", ScreenTip:="", _
            TextToDisplay:=strLinkText
           
        Selection.Start = Selection.End
    Else
        ' do nothing
    End If

End Function

Процедура AhFindAndPaintLinks

'
' AhFindAndPaintLinks
'
Private Sub AhFindAndPaintLinks(ByVal strPrefix As String, ByVal strPattern As String)
If Documents.Count = 0 Then Exit Sub
    Application.ScreenUpdating = False
    Debug.Print "AhFindAndPaintHyperLinks START"
   
    Selection.HomeKey Unit:=wdStory ' move to the document.start
    Do While AhHyperlinkFindAndAdd("", strPrefix + strPattern)
    Loop
   
    Selection.HomeKey Unit:=wdStory ' move to the document.start
    Do While AhHyperlinkFindAndAdd(strPrefix, strPattern)
    Loop
   
    Debug.Print "AhFindAndPaintHyperLinks END" & vbCrLf
    Application.ScreenUpdating = True
End Sub

Процедура AhFindAndPaintHyperLinks

'
' AhFindAndPaintHyperLinks
'
Sub AhFindAndPaintHyperLinks()
    AhFindAndPaintLinks cStrPrefixHttp, cStrRegExpHttp
End Sub

Процедура AhFindAndPaintEMails

'
' AhFindAndPaintEMails
'
Sub AhFindAndPaintEMails()
    AhFindAndPaintLinks cStrPrefixMail, cStrRegExpMail
End Sub

Процедура AhFindAndPaintAllLinks

'
' AhFindAndPaintAllLinks
'
Sub AhFindAndPaintAllLinks()
If Documents.Count = 0 Then Exit Sub
    AhFindAndPaintLinks cStrPrefixHttp, cStrRegExpHttp  ' HTTP
    AhFindAndPaintLinks cStrPrefixFtp, cStrRegExpHttp   ' FTP
    AhFindAndPaintLinks cStrPrefixMail, cStrRegExpMail  ' E-MAIL
End Sub

Выводы

В этом этюде на основе спецификации создан шаблон "AhTextHyperlinks.dot", модуль "AhTextHyperlinks" которого содержит макросы для работы с гиперссылками. Созданная панель инструментов "AhTextHyperlinks", предоставляет простой интерфейс к операциям создания (поиска и "раскраски") и удаления гиперссылок.

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

Задание 1

Измените макросы так, чтобы в случае наличия выделенного текста он работал только с выделенным текстом, в противном случае со всем документом. В обоих случаях необходимо восстанавливать исходное выделение по окончании работы.

 

Задание 2

Правила составления адресов электронной почты гораздо сложнее, чем может показаться на первый взгляд. Так, например, приведенные выше шаблоны не допускают IP-адрес в качестве имени хоста. Также за бортом остаются адреса типа "Name.Family@domain.host".

Шаблон для гиперссылок игнорирует номер порта HTTP, а также префикс "https://"
(так адрес типа "https://www.transcriber.ru:8080" не будет найден).

Усовершенствуйте шаблоны поиска, используемые для поиска в модуле AhTextHyperlinks. При необходимости проконсультируйтесь с документом "RFC 822".

 

Задание 3 (Find and Replace)

С помощью диалога "Replace" раскрасьте все вхождения любого слова (например, "he" -  англ. "он") в синий цвет. Результат должен выглядеть примерно следующим образом:

 

 

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

Проделайте то же самое ещё раз в режиме записи макросов. Запустите макрос на выполнение и убедитесь в том, что раскрашивание не работает. Причина в ошибке автоматической генерации макросов Microsoft Word. Теперь, когда Вы познакомились со свойствами объектов Find и Replacement (а Вы ведь познакомились, не правда ли?), сможете ли Вы исправить ошибку самостоятельно?

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

Текст примера взят из эссе Джоэла Спольского "The Development Abstraction Layer", опубликованного на сайте http://www.joelonsoftware.com/printerFriendly/articles/DevelopmentAbstraction.html.

 

Если Вам понадобится использовать регулярные выражения в своих собственных программах, обратитесь к библиотеке Boost http://www.boost.org/libs/regex/doc/introduction.html.

См. также страницу MSDN "How to: Verify That Strings are in Valid E-Mail Format".

 


Этюды для программистов Microsoft Word. Этюд 1.3. Поиск и раскраска гиперссылок.


© 2000-2009 Евгений Ахунджанов, Все Права Сохранены.
www.transcriber.ru | Послать письмо автору