Смарт-теги в Microsoft Office фирменного и кустарного приготовления
Листинг 3. Код макрокоманды MyStartTags
Public Const ListFolder As String = _
"C:\Program Files\Common Files\Microsoft Shared\Smart Tag\Lists\"
Public FindWord$ ' то, что передается Form
Sub MySmartTags()
'
' Интеллектуальная обработка терминов кустарным способом
'
' ----------------------------------------------
Dim PathName$, FileName$
Dim MyWord$
MyWord$ = Trim$(Selection.Text)
If Len(MyWord$) < 2 Then
MsgBox "Не выделен термин!": Exit Sub
End If
'
' Поиск XML-файлов
PathName$ = ListFolder$ + "*.xml"
FileName$ = Dir(PathName$)
If FileName$ = "" Then
MsgBox "Нет списка XML-описателей смарт-тегов"
Exit Sub
End If
Do
' обращение на поиск термина в данном распознавателе
If OneXMLFile(ListFolder$ & FileName$, MyWord$) Then _
Exit Sub ' найден термин
FileName$ = Dir ' продолжаем поиск
Loop While FileName$ <> ""
MsgBox "Термин " & Chr$(34) & MyWord & Chr$(34) & _
" не найден в XML-распознавателях"
End Sub
Function OneXMLFile(FileName$, MyWord$)
'
' Поиск заданного слова (MyWord$) в XML-описателе (FileName$)
' Выход: OneXMLFile = True - слово найдено
'
Dim xmlDoc As DOMDocument
Dim FLname$, FLnameNode As IXMLDOMElement
Dim FLacts As IXMLDOMElement
Dim FLaction As IXMLDOMElement
Dim FLactList As IXMLDOMNodeList
On Error GoTo XMLError ' включение ошибок
Set xmlDoc = New DOMDocument
xmlDoc.Load (FileName$)
' MsgBox FileName$
' имя распознавателя
Set FLnameNode = xmlDoc.selectSingleNode("FL:smarttaglist/FL:name")
FLname = FLnameNode.Text
' список терминов
Set FLnameNode = xmlDoc.selectSingleNode _
("FL:smarttaglist/FL:smarttag/FL:terms/FL:termlist")
Dim TermList$() ' массив терминов
Dim i%
TermList$ = Split(FLnameNode.Text, ",")
FindWord = ""
For i = LBound(TermList) To UBound(TermList)
' Вариант поиска с точным совпадением:
'If MyWord$ = TermList$(i) Then ' найден
' Вариант поиска с учетом окончаний и без учета регистра:
If LCase(MyWord$) Like LCase(TermList$(i)) & "*" Then ' найден
FindWord = TermList(i): Exit For
End If
Next
' FindWord -- глобальная переменная для
' передачи термина в форму
If FindWord = "" Then ' не найден
OneXMLFile = False
Exit Function
End If
'
' Выбираем узлы Action
Set FLacts = xmlDoc.selectSingleNode _
("FL:smarttaglist/FL:smarttag/FL:actions")
Set FLactList = FLacts.selectNodes("//FL:action")
' Формируем списки имен команд и действий
For Each FLaction In FLactList
UserForm1.ListBox1.AddItem FLaction.selectSingleNode("FL:caption").Text
UserForm1.ListBox2.AddItem FLaction.selectSingleNode("FL:url").Text
Next
UserForm1.Caption = "Распознаватель: " & FLname
UserForm1.Label1.Caption = "Обработка термина: " & FindWord$
' Обращаемся к форме для выбора операции
UserForm1.Show
'
Set xmlDoc = Nothing
OneXMLFile = True
Exit Function
XMLError:
' ошибка будет только, если неверно сформирован XML-файл
MsgBox "Ошибка при обработке файла " & FileName$
OneXMLFile = False
End Function
