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

Home ] Up ]


 

Этюд 4.1. Сохранение состояния документов

Ресурсы

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

Конкурс "Microsoft Office Extensions"



 

Программа "AhDocStateSaver" принимала участие в конкурсе "Microsoft Office Extensions" (см. http://www.offext.ru), который проводится русской редакцией журнала PC Magazine совместно с корпорацией Microsoft.

Программа послана на конкурс в феврале 2008 года.
Программа успешно прошла тестирование и получила логотип "Yes, it Works!".

Страничка программы "AhDocStateSaver" на сайте "Microsoft Office Extensions".

 

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

Задача

Microsoft Word всегда устанавливает каретку в начало открываемого документа. Это неправильно, а при работе с большими документами и неудобно. Документы должны открываться в том же состоянии, в котором они находились в момент закрытия.

Задача состоит в создании шаблона "AhDocStateSaver.dot", использующего события Microsoft Word, сохраняющего состояние документов при их закрытии и восстанавливающего сохраненное состояние документа при его последующем открытии.

Помимо места расположения каретки, шаблон должен сохранять следующие параметры документа:

Параметр

Комментарий

SelBeg, SelEnd

Первая и последняя позиция выделения (Selection).

Zoom

Увеличение

VScroll

Положение вертикального скроллинга.

View

Вид (Normal, Web, Print, Reading, Outline).

Параметры

Все параметры Программы хранятся в формате XML в файле "AhDocStateSaver.xml" , который находится в той же папке, что и сама Программа (шаблон "AhDocStateSaver.dot").

Атрибут "language" узла "settings" отвечает за язык пользовательского интерфейса программы ("rus" - русский, "eng" - английский).   При необходимости файл "AhDocStateSaver.xml" может быть отредактирован в любом XML редакторе.

Файл "AhDocStateSaver.xml" имеет примерно следующий вид:

<documents>

<settings language="rus"/>

<document Path="__Default_|_Document_|_State__" View="3" VScroll="0" Zoom="100" SelBeg="669" SelEnd="674"/>
<document Path="D:\_Ah\AhDocStateSaver.doc" View="3" VScroll="0" Zoom="111" SelBeg="829" SelEnd="850"/>
<document Path="D:\_Ah\AhDocStateSaver.dot" View="3" VScroll="40" Zoom="100" SelBeg="883" SelEnd="883"/>
</documents>

Специальное значение параметра Path = "__Default_|_Document_|_State__" используется для хранения состояния документа "по умолчанию", которое используется при открытии новых документов.

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

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

Доступ к (необязательным) функциям программы осуществляется с помощью панели инструментов "AhDocStateSaver", которая имеет следующий вид:

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

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

Макрос

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

AhDocStateSaverHelp

Краткая подсказка по кнопкам панели инструментов.
Информация о версии программы
.

AhDocStateSaverSwitch

Выключение программы. После нажатия иконка изменяется на .

AhDocStateSaverSwitch

Включение программы. После нажатия иконка изменяется на .

AhDocStateSaverDialog

Диалог "Документы". Позволяет быстро открыть нужный документ или удалить неиспользуемые файлы. Может также использоваться вместо списка "последних открытых файлов" (Most Recent Used) в меню "Файл", так как не имеет ограничений по размеру.

Краткая подсказка

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

Диалог "Документы"

Диалог "Документы" имеет следующий вид:

Для открытия документа следует выбрать документ из списка и нажать кнопку "Открыть".

Для удаления документа из списка следует выбрать документ и нажать кнопку "Удалить". После завершения удаления документов нажатие кнопки "OK" сохраняет сделанные изменения, а нажатие кнопки "Cancel" отменяет сделанные изменения.

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

Шаблон содержит три модуля классов - AhDocData (состояние документа), AhDocColl (коллекция состояний документов), AhDocStateSaverWordApp (обработка событий), один модуль формы (AhDocStateSaverDocumentsForm) и основной модуль AhDocStateSaver.

Модуль класса AhDocData - состояние одного документа

Класс AhDocData представляет структуру данных, отвечающих за состояние одного документа. Помимо конструктора и деструктора, класс содержит ещё две процедуры. Процедура SetDocData заполняет структуру данными документа, а процедура ApplyTo, наоборот, применяет данные к документу. Процедура Dump является необязательной и используется при отладке.

'
' File AhDocStateSaver.dot|AhDocData
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' © 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Data members
'
Public strFullName As String
Public iView As Long
Public iSelBeg As Long
Public iSelFin As Long
Public iVScr As Long
Public iZoom As Long
'
' Constructor
'
Private Sub Class_Initialize()
    strFullName = ""
    iView = wdPrintView ' wdNormalView  ' ### make this setting for new document
    iSelBeg = 0
    iSelFin = 0
    iVScr = 0
    iZoom = 100
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
End Sub
'
' SetDocData
'
Public Sub SetDocData(aDoc As Document)
    strFullName = aDoc.FullName
   
    With Selection
        iSelBeg = .Range.Start
        iSelFin = .Range.End
    End With
   
    With aDoc.ActiveWindow
        iView = .view.Type
        iZoom = .view.Zoom.Percentage
        iVScr = .VerticalPercentScrolled
    End With
End Sub
'
' ApplyTo
'
Public Sub ApplyTo(aDoc As Document, Optional ByVal bApplyRange As Boolean = True)
    Debug.Print "ApplyTo <" & aDoc.FullName & ">."
    With aDoc.ActiveWindow
        .view.Type = iView
        .view.Zoom.Percentage = iZoom
        .VerticalPercentScrolled = iVScr
    End With

    If bApplyRange Then
        Dim aRange As Range
        Set aRange = Selection.Range
        aRange.Start = iSelBeg
        aRange.End = iSelFin
        aRange.Select
    End If
End Sub
'
' Dump
'
Sub Dump()
    Debug.Print "   sPath = <" & strFullName & ">."
    Debug.Print "   iView = " & iView
    Debug.Print "   iZoom = " & iZoom
    Debug.Print "   iVScr = " & iVScr
    Debug.Print "   iSelBeg = " & iSelBeg
   
Debug.Print "   iSelFin = " & iSelFin
End Sub

Модуль класса AhDocColl - коллекция данных документов

Класс AhDocColl - это "обертка" вокруг коллекции структур типа AhDocData. Функция Register добавляет элемент в коллекцию, а функция Unregister удаляет элемент из коллекции. Функции FindIndex4FilePath и FindIndexOf используется для поиска элемента в коллекции. Функции Load и Save предназначены для обмена данными между коллекцией и файлом формата XML.

'
' File AhDocStateSaver.dot|AhDocColl
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' © 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Data members
'
Private docs As Collection
'
' XML File
'
Const MSXML = "Msxml2.DOMDocument.3.0"
Private Const cStrParFileName As String = "AhDocStateSaver.xml"
Private Const cStrErrSaveText As String = "Error saving documents collection to XML file <%1>."
Private Const cStrErrLoadText As String = "Error loading documents collection from XML file <%1>."
'
' XML 'Root' node attributes
'
Private Const cStrParRoot As String = "documents"
Private Const cStrParNode As String = "document"
'
' settings
'
Private Const cStrParSett As String = "settings"
Private Const cStrParLang As String = "language"
'
' XML 'Document' node attributes
'
Private Const cStrParPath As String = "Path"
Private Const cStrParSBeg As String = "SelBeg"
Private Const cStrParSEnd As String = "SelEnd"
Private Const cStrParView As String = "View"
Private Const cStrParVscr As String = "VScroll"
Private Const cStrParZoom As String = "Zoom"
'
'
'
Private Const cStrRegTextNotFound As String = "Register [%1]. Not Found. Added."
Private Const cStrRegTextFound As String = "Register [%1]. Found."

Private Const cStrUnRegTextFound As String = "Unregister [%1]. Found and Deleted."
Private Const cStrUnRegTextNotFound As String = "Unregister [%1]. NOT FOUND."
'
' Constructor
'
Private Sub Class_Initialize()
    Set docs = New Collection
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
    Set docs = Nothing
End Sub
'
' Register
'
Public Function Register(aDoc As Document) As Boolean
Dim dd As AhDocData
    For Each dd In docs
        ' If aDoc Is docs(iItem).doc Then   ' WRONG! Use 'Is' instead of '=; for objects.
        ' If aDoc Is dd.doc Then
        If LCase(dd.strFullName) = LCase(aDoc.FullName) Then
            '
            ' found
            '
            dd.SetDocData aDoc
            Debug.Print Replace(cStrRegTextFound, "%1", aDoc.Name)
            Register = True  ' means found and doc data was changed
            Exit Function
        End If
    Next dd
    '
    ' not found - create new item
    '
    Dim aNewDocData As New AhDocData
    aNewDocData.SetDocData aDoc
    '
    ' Add item to the collection
    '
    docs.Add aNewDocData
    Debug.Print Replace(cStrRegTextNotFound, "%1", aDoc.Name)
    Register = False ' means not found and new object was created
End Function
'
' Unregister
'
Public Function Unregister(aDoc As Document) As Boolean
    Dim iItem As Long
    For iItem = 1 To docs.Count
        ' If aDoc Is docs(iItem).doc Then
        If LCase(docs(iItem).Doc.FullName) = LCase(aDoc.FullName) Then
            '
            ' found
            '
            Debug.Print Replace(cStrUnRegTextFound, "%1", aDoc.Name)
            docs.Remove (iItem)
            Unregister = True    ' means found and removed
            Exit Function
        End If
    Next iItem
    '
    ' not found
    '
    Debug.Print Replace(cStrUnRegTextNotFound, "%1", aDoc.Name)
    Unregister = False ' means not found
End Function
'
' FindIndexOf
'
Public Function FindIndexOf(aDoc As Document) As Long
    FindIndexOf = FindIndex4FilePath(aDoc.FullName)
End Function
'
' FindIndex4FilePath
'
Public Function FindIndex4FilePath(ByVal strFilePath As String) As Long
    Dim strfilename As String
    strfilename = LCase(strFilePath)
    Dim strFileItem As String
   
    Dim iItem As Long
    For iItem = 1 To docs.Count
        strFileItem = docs(iItem).strFullName
        ' Debug.Print iItem & "/. " & strfileitem
        If LCase(strFileItem) = strfilename Then
            '
            ' found
            '
            FindIndex4FilePath = iItem
            Exit Function
        End If
    Next iItem
    '
    ' not found
    '
    FindIndex4FilePath = ciNotFound
End Function
'
' GetSize
'
Public Function GetSize() As Long
    GetSize = docs.Count
End Function
'
' GetDocName
'
Public Function GetDocName(ByVal iItem As Long) As String
    GetDocName = docs(iItem).strFullName
End Function
'
' DeleteItem
'
Sub DeleteItem(ByVal iItem As Long)
    docs.Remove iItem
End Sub
'
' Dump
'
Sub Dump(ByVal strTitle As String)
    Dim nItems As Long
    nItems = docs.Count
    Debug.Print "AhDocColl Dump +++ Items = " & nItems & "<--- " & strTitle
    Dim iItem As Long
    For iItem = 1 To nItems
        Debug.Print "  " & CStr(iItem) & "/. [" & docs(iItem).strFullName
        docs(iItem).Dump
    Next iItem
    Debug.Print "AhDocColl Dump ==="
End Sub
'
' ApplyTo
'
Public Sub ApplyTo(ByVal ind As Long, aDoc As Document)
    docs(ind).ApplyTo aDoc
End Sub
'
' AhXMLInit
'
Private Function AhXMLInit(ByRef xmldoc, ByVal xmlFilePath As String, ByVal strErrMess As String) As Boolean
 strErrMess = ""
 
 On Error Resume Next
 Set xmldoc = CreateObject(MSXML)
 xmldoc.async = False
 xmldoc.resolveExternals = False
 xmldoc.validateOnParse = False
 xmldoc.preserveWhiteSpace = True
 
 If Len(xmlFilePath) > 0 Then
    '
    ' load XML file
    '
    xmldoc.Load xmlFilePath
 
    If (Err.Number = 0) Then
        AhXMLInit = True
    Else
        AhXMLInit = False
        strErrMess = "File <" & xmlFilePath & "> load error [" & xmldoc.parseError.errorCode & "]."
    End If
 
 Else
    ' do not load
    AhXMLInit = True
 End If
 End Function
'
' AhGetXMLPath
'
Private Function AhGetXMLPath() As String
    AhGetXMLPath = Application.StartupPath + "\" + cStrParFileName
End Function
'
' AhXMLCreateSett
'
Private Sub AhXMLCreateSett(ByRef xmldoc, ByRef xmlroot)
    '
    ' settings
    '
    Dim e
    Set e = xmldoc.createElement(cStrParSett)
       
    e.setAttribute cStrParLang, AhGetLanguageAsString
    ' e.setAttribute cStrParXXX, XXX
    xmlroot.appendChild e
    '
    ' space
    '
    Dim s
    Set s = xmldoc.createTextNode(vbCrLf)
    xmlroot.appendChild s
   
End Sub

'
' AhXMLCreateNode
'
Private Sub AhXMLCreateNode(ByRef xmldoc, ByRef xmlroot, ByRef dd As AhDocData)
    '
    ' document
    '
    Dim e
    Set e = xmldoc.createElement(cStrParNode)
       
    e.setAttribute cStrParPath, dd.strFullName
    e.setAttribute cStrParView, dd.iView
    e.setAttribute cStrParVscr, dd.iVScr
    e.setAttribute cStrParZoom, dd.iZoom
    e.setAttribute cStrParSBeg, dd.iSelBeg
    e.setAttribute cStrParSEnd, dd.iSelFin
    xmlroot.appendChild e
       
    '
    ' space
    '
    Dim s
    Set s = xmldoc.createTextNode(vbCrLf)
    xmlroot.appendChild s
End Sub
'
' Save
'
Public Sub Save()
    On Error GoTo ErrorLabel
    Debug.Print "AhDocColl::Save"
    Dim strErrMess As String
    Dim filePath As String
    filePath = AhGetXMLPath
   
    '
    ' xml
    '
    Dim xmldoc
    If Not AhXMLInit(xmldoc, "", strErrMess) Then
        MsgBox strErrMess
        Exit Sub
    End If
   
    '
    ' root
    '
    Dim xmlroot
    Set xmlroot = xmldoc.createElement(cStrParRoot)
    xmldoc.appendChild xmlroot
       
    Dim space
    Set space = xmldoc.createTextNode(vbCrLf)
    xmlroot.appendChild space
   
    '
    ' default doc state (special file path is used)
    '
    DocDataDflt.strFullName = cStrDefDocStateName
    AhXMLCreateNode xmldoc, xmlroot, DocDataDflt
    '
    ' <document> nodes
    '
    Dim iItem As Long
    For iItem = 1 To docs.Count
        AhXMLCreateNode xmldoc, xmlroot, docs(iItem)
    Next iItem
   
    '
    ' <settings>
    '
    AhXMLCreateSett xmldoc, xmlroot
   
    xmldoc.Save filePath
    Exit Sub
   
ErrorLabel:
    MsgBox Replace(cStrErrSaveText, "%1", filePath)
End Sub
'
' AhXmlNode2Long
'
Private Function AhXmlNode2Long(ByVal xmlNodes As Variant, ByVal iNode As Long, ByVal cStrAttrName As String, ByVal iDefault As Long) As Long
    Dim x
    x = xmlNodes(iNode).getAttribute(cStrAttrName)
    ' If (x <> Null) And (x <> "") Then
    Debug.Print "Node " & CStr(iNode) & ". Attr = <" & cStrAttrName & "> is <" & x & ">."
    If x <> "" Then
        On Error Resume Next
        AhXmlNode2Long = CLng(x)
    Else
        ' do nothing but report
        Debug.Print "   *** is Empty."
        AhXmlNode2Long = iDefault
    End If
End Function
'
' Load
'
Public Sub Load()
    Debug.Print "AhDocColl::Load"
    Dim strErrMess As String
    Dim filePath As String
    filePath = AhGetXMLPath
   
    Dim xmldoc
    If Not AhXMLInit(xmldoc, filePath, strErrMess) Then
        MsgBox strErrMess
        Exit Sub
    End If
   
    On Error GoTo ErrorLabel
    Dim bFileExists As Boolean
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
   
    Dim xPath As String
    xPath = "//" + cStrParRoot + "/" + cStrParNode
    Dim n, nNodes
    Dim xmlNodes
    If xmldoc.documentElement Is Nothing Then
        nNodes = 0
    Else
        Set xmlNodes = xmldoc.documentElement.SelectNodes(xPath)
        nNodes = xmlNodes.Length
    End If
   
   
    ' MsgBox "nNodes = " & nNodes
    Dim strPath As String
    Dim dd As AhDocData
    For n = 0 To nNodes - 1
        strPath = xmlNodes(n).getAttribute(cStrParPath)
        Debug.Print (n + 1) & "/. name = <" & strPath & ">."
        '
        ' We don't validate xml data integrity here.
        ' Check file existence only.
        If (strPath <> "") Then
            Set dd = New AhDocData
            '
            ' doc path
            '
            dd.strFullName = strPath
            '
            ' other attributes
            '
            dd.iView = AhXmlNode2Long(xmlNodes, n, cStrParView, dd.iView)
            dd.iVScr = AhXmlNode2Long(xmlNodes, n, cStrParVscr, dd.iVScr)
            dd.iZoom = AhXmlNode2Long(xmlNodes, n, cStrParZoom, dd.iZoom)
            dd.iSelBeg = AhXmlNode2Long(xmlNodes, n, cStrParSBeg, dd.iSelBeg)
            dd.iSelFin = AhXmlNode2Long(xmlNodes, n, cStrParSEnd, dd.iSelFin)
           
            bFileExists = fs.FileExists(strPath)
            If bFileExists Then
                '
                ' add new element to the collection
                '
                docs.Add dd
            ElseIf (strPath = cStrDefDocStateName) Then
                DocDataDflt.strFullName = cStrDefDocStateName
                DocDataDflt.iView = dd.iView
                DocDataDflt.iVScr = dd.iVScr
                DocDataDflt.iZoom = dd.iZoom
                DocDataDflt.iSelBeg = dd.iSelBeg
                DocDataDflt.iSelFin = dd.iSelFin
            End If
            Set dd = Nothing
        Else
            ' ignore node with empty path
        End If
    Next n
   
    Set fs = Nothing
   
    '
    ' settings
    '
    xPath = "//" + cStrParRoot + "/" + cStrParSett
    If xmldoc.documentElement Is Nothing Then
    Else
        Set xmlNodes = xmldoc.documentElement.SelectNodes(xPath)
        nNodes = xmlNodes.Length
        If nNodes > 0 Then
            Dim strPar As String
            strPar = xmlNodes(0).getAttribute(cStrParLang)
            lang_ = AhGetLanguage(strPar)
            Debug.Print "Language = " & lang_
        End If
    End If
   
    Dump "--- After Load ---"
    Exit Sub
   
ErrorLabel:
    Set fs = Nothing
    MsgBox Replace(cStrErrLoadText, "%1", filePath)
End Sub

Модуль класса AhDocStateSaverWordApp - отработка событий

Модуль класса AhDocStateSaverWordApp это обработчик событий Microsoft Word. Класс содержит ссылку (reference) на объект Word.Application, а описатель WithEvents позволяет перехватывать события Microsoft Word. Ссылка на объект Word.Application инициализируется и освобождается в главном модуле плагина при его включении и выключении соответственно.

Модуль перехватывает события DocumentBeforeClose, DocumentOpen и  NewDocument. При закрытии документа его состояние запоминается. При открытии документа его состояние восстанавливается при условии, что этот документ был открыт раньше и его состояние было сохранено. В противном случае, к документу применяется состояние "по умолчанию". То же состояние "по умолчанию" применяется и к новым документам.

'
' File AhDocStateSaver.dot|AhDocStateSaverWordApp
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' © 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Word Application Object (With Events)
'
Public WithEvents obj As Word.Application
'
' Note, that event handlers below should be named as obj_XXX to really catch events.
'
'
' Constructor
'
Private Sub Class_Initialize()
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
End Sub
'
' DocumentBeforeClose
'
Private Sub obj_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
    Debug.Print "DocumentBeforeClose " & Doc.Name
    AhDocStateSaverRegDoc Doc
End Sub
'
' DocumentOpen
'
Private Sub obj_DocumentOpen(ByVal Doc As Document)
    Debug.Print "DocumentOpen " & Doc.Name
    AhDocStateSaverOpenDoc Doc
End Sub

Private Sub obj_NewDocument(ByVal Doc As Document)
    AhDocStateSaverNewDoc Doc
End Sub

'
' Quit
'
Private Sub obj_Quit()
   
AhDocStateSaverExit
End Sub

Модуль формы AhDocStateSaverDocumentsForm - форма

Форма AhDocStateSaverDocumentsForm предоставляет интерфейс и некоторые функции для работы с сохраненной коллекцией состояний документов. Любой документ можно удалить из коллекции или открыть для редактирования. Форма работает с копией коллекции, поэтому при закрытии формы нажатие кнопки OK сохраняет произведенные с копией изменения в основной коллекции, а  нажатие кнопки Cancel отменяет сделанные изменения.

'
' File AhDocStateSaver.dot|AhDocStateSaverDocumentsForm
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' © 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Dialog data
'
Public dwDialogResult As Long
Public dwSelectedItem As Long

Private DocsCollCopy As AhDocColl
'
' Constructor
'
Private Sub UserForm_Initialize()
    dwDialogResult = vbCancel
    Set DocsCollCopy = DocsColl
End Sub
'
' Destructor
'
Private Sub UserForm_Terminate()
    Set DocsCollCopy = Nothing
End Sub
'
' InitDialogData
'
Public Sub InitDialogData()
    '
    ' ListBox
    '
    Dim k As Long
    Dim dwSize As Long
    dwSize = DocsCollCopy.GetSize
    For k = 1 To dwSize
        ListBox1.AddItem DocsCollCopy.GetDocName(k)
    Next k

    ListBox1.ColumnHeads = False
    ListBox1.MultiSelect = fmMultiSelectSingle
   
    '
    ' Enable Controls
    '
    If 0 = ListBox1.ListCount Then
        btnDelete.Enabled = False
        btnOK.Enabled = False
        btnOpen.Enabled = False
    Else
        ListBox1.Selected(0) = True
    End If
   
    If lang_ = langEng Then
    Me.Caption = "AhDocStateSaver - Documents"
    ' delete
    btnDelete.Caption = "Delete"
    btnDelete.ControlTipText = "Delete selected document from the list"
    ' open
    btnOpen.Caption = "Open"
    btnOpen.ControlTipText = "Open selected document"
    ' cancel
    btnCancel.Caption = "Cancel"
    btnCancel.ControlTipText = "Close form discarding changes"
    ' OK
    btnOK.ControlTipText = "Close form saving changes"
   
    SaveItSelf
    End If
   
End Sub
'
' Delete
'
Private Sub btnDelete_Click()
    If 0 = ListBox1.ListCount Then Exit Sub
    Dim dwSelectedItem As Long
    dwSelectedItem = ListBox1.ListIndex
    ' delete item from the collection
    ' Ah! 13-Mar-2008. Bug fixed - note this (+1) below.
    DocsCollCopy.DeleteItem dwSelectedItem
+ 1
   
    ' remove list control item
    ListBox1.RemoveItem dwSelectedItem
End Sub
'
' DblClick on List
'
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    btnOpen_Click
End Sub
'
' UnloadForm
'
Private Sub UnloadForm()
    Set DocsCollCopy = Nothing
    Unload Me
End Sub
'
' Open
'
Private Sub btnOpen_Click()
    If 0 = ListBox1.ListCount Then Exit Sub
    Dim dwSelectedItem As Long
    dwSelectedItem = ListBox1.ListIndex + 1
    Dim strDocPath As String
    strDocPath = DocsCollCopy.GetDocName(dwSelectedItem)
   
    On Error GoTo ErrorLabel
    Documents.Open strDocPath
   
   
'
    ' Open does,'t save changes.
    '
    UnloadForm
    Exit Sub
ErrorLabel:
    '
    ' report error
    '
    Dim cStrDocCannotOpenFile As String
    If lang_ = langEng Then
        cStrDocCannotOpenFile = "Cannot open file <%1>."
    Else
        cStrDocCannotOpenFile = "Îøèáêà îòêðûòèÿ ôàéëà <%1>."
    End If
    MsgBox Replace(cStrDocCannotOpenFile, "%1", strDocPath)
End Sub
'
' Cancel
'
Private Sub btnCancel_Click()
    dwDialogResult = vbCancel
    UnloadForm
End Sub
'
' OK
'
Private Sub btnOK_Click()
    ' dwSelectedItem = ListBox1.ListIndex
    dwDialogResult = vbOK
    Set DocsColl = DocsCollCopy
    UnloadForm
End Sub

Модуль AhDocStateSaver - склеиваем все вместе

Главный модуль плагина. Автомакросы используются для автоматической инициализации плагина. Процедура AhDocStateSaverInit включает плагин при старте или нажатии кнопки "Включить", а процедура AhDocStateSaverExit выключает плагин при выходе или нажатии кнопки "Выключить". Обе процедуры используются также в процедуре AhDocStateSaverSwitch, переключающей состояние плагина.  Процедура AhDocStateSaverDialog показывает форму "Документы", а процедуры AhDocStateSaverRegDoc, AhDocStateSaverNewDoc и AhDocStateSaverOpenDoc являются обработчиками событий.

'
' File AhDocStateSaver.dot|AhDocStateSaver
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' © 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' MS Word Object
'
Dim WordObject As New AhDocStateSaverWordApp
'
' Documents Collection
'
Public DocsColl As AhDocColl
'
' Default DocData Object
'
Public DocDataDflt As AhDocData
'
' Common Constants
'
Public Const ciNotFound As Long = -1

Public Const langEng As Long = 0
Public Const langRus As Long = 1
Public lang_ As Long

'
' Debug Strings are in Enlish
'
Private Const cStrDocFound As String = "Document <%1> found in the Collection!"
Private Const cStrDocNotFound As String = "Document <%1> NOT FOUND in the Collection!"
Private Const cStrWordCreated As String = "Word Object created."
Private Const cStrWordDestroyed As String = "Word Object destroyed."
Private Const cStrCollCreated As String = "Documents Collection created and loaded."
Private Const cStrCollSavedAndDestroyed As String = "Documents Collection saved and destroyed."
Private Const cStrThisTemplateName As String = "AhDocStateSaver.dot"
Private Const cStrToolbarName As String = "AhDocStateSaver"
'
Public Const cStrDefDocStateName As String = "__Default_|_Document_|_State__"
'
Private Const cbOnDialogPressedInitPlugin As Boolean = True

'
' AhDocStateSaverHelp
'
Sub AhDocStateSaverHelp()
Dim strState As String
If lang_ = langEng Then
    strState = "Document State Saver is "
    If WordObject.obj Is Nothing Then
        strState = strState + "not "
    End If
    strState = strState + "activated."

    MsgBox "Etudes for Microsoft Word Programmers." & vbCrLf & vbCrLf & _
        "Etude 4.1. Document State Saver." & vbCrLf & _
        " © 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide." & vbCrLf & _
        "http://www.transcriber.ru" & vbCrLf & vbCrLf & _
        "Template 'AhDocStateSaver.dot' - saves document state on close " & _
        "and restores on open." & vbCrLf & vbCrLf & _
        strState & vbCrLf & vbCrLf & _
        "Special version for 'Microsoft Office Extensions' contest."
Else
    ' assume russian
    strState = "
Плагин  "
    If WordObject.obj Is Nothing Then
        strState = strState + "
выключен."
    Else
        strState = strState + "
включен."
    End If

    MsgBox "
Этюды для программистов Microsoft Word." & vbCrLf & vbCrLf & _
        "
Этюд 4.1. AhDocStateSaver - Сохранение состояния документов." & vbCrLf & _
        "
Версия для конкурса 'Microsoft Office Extensions'." & vbCrLf & vbCrLf & _
        " © 2007-2008. Евгений Ахунджанов. Все права сохранены. " & _
        "http://www.transcriber.ru" & vbCrLf & vbCrLf & _
        "Плагин 'AhDocStateSaver.dot' - сохраняет состояние документов при закрытии " & _
        "и восстанавливает при открытии."
& vbCrLf & vbCrLf & _
        strState & vbCrLf & vbCrLf
End If
End Sub
'
' AutoExec
'
Sub AutoExec()
    Debug.Print "AutoExec"
    AhDocStateSaverInit
End Sub
'
' AutoOpen
'
Sub AutoOpen()
    Debug.Print "AutoOpen"
    AhDocStateSaverInit
End Sub
'
' AutoClose
'
Sub AutoClose()
    Debug.Print "AutoClose"
End Sub
'
' AutoExit
'
Sub AutoExit()
    Debug.Print "AutoExit"
    AhDocStateSaverExit
End Sub
'
' AhDocStateSaverInit
'
Sub AhDocStateSaverInit()
    lang_ = langRus ' default language
    Debug.Print "AhDocStateSaverInit +++"
    '
    ' create word application ref. object
    '
    If WordObject.obj Is Nothing Then
        Set WordObject.obj = Word.Application
        Debug.Print cStrWordCreated
    End If
   
    '
    ' create documents collection object
    '
    If DocsColl Is Nothing Then
        Set DocDataDflt = New AhDocData
        Set DocsColl = New AhDocColl
        DocsColl.Load
        Debug.Print cStrCollCreated
    End If
    Debug.Print "AhDocStateSaverInit ==="
    AhDocStateSaverState
End Sub
'
' AhDocStateSaverExit
'
Sub AhDocStateSaverExit()
    Debug.Print "AhDocStateSaverExit +++"
    '
    ' save and destroy documents collection object
    '
    If Not DocsColl Is Nothing Then
        DocsColl.Save
        Set DocsColl = Nothing
        Set DocDataDflt = Nothing
        Debug.Print cStrCollSavedAndDestroyed
    End If
   
    '
    ' destroy word application ref. object
    '
    If Not WordObject.obj Is Nothing Then
        Set WordObject.obj = Nothing
        Debug.Print cStrWordDestroyed
    End If

    Debug.Print "AhDocStateSaverExit ==="
    AhDocStateSaverState
End Sub
'
' AhDocStateSaverDump
'
Sub AhDocStateSaverDump()
    If Not DocsColl Is Nothing Then
        DocsColl.Dump "AhDocStateSaverDump"
    Else
        Debug.Print "AhDocStateSaverDump: DocsColl Is Nothing"
    End If
End Sub
'
' AhDocStateSaverState
'
Sub AhDocStateSaverState()
    Dim dwFaceId As Long
    Dim dwState As Long
    Dim strState As String
    If WordObject.obj Is Nothing Then
        strState = "AhDocStateSaver is not activated."
        dwFaceId = 9030
        dwState = msoButtonUp
    Else
        strState = "AhDocStateSaver is activated."
        dwFaceId = 9029
        dwState = msoButtonDown
    End If

    Dim ctrl As CommandBarControl
    For Each ctrl In CommandBars(cStrToolbarName).Controls
        If ctrl.OnAction = "AhDocStateSaver.AhDocStateSaverSwitch" Then
            ctrl.State = dwState
            ctrl.FaceId = dwFaceId
            ctrl.Caption = ctrl.Caption + " "   ' force change
            ctrl.Caption = strState
            SaveItSelf
            Exit For
        End If
    Next ctrl
End Sub
'
' SaveItSelf - makes template with name cStrThisTemplateName "Saved".
'
Public Sub SaveItSelf()
    Dim tt As Template
    For Each tt In Templates
        If LCase(tt.Name) = LCase(cStrThisTemplateName) Then
            tt.Saved = True
        End If
    Next tt
   
    ' Ah! 12-Apr-2007. Attached templates 'Save MsgBox' problem fixed.
    If Documents.Count > 0 Then
        On Error Resume Next
        ActiveDocument.AttachedTemplate.Saved = True
    End If
End Sub
'
' AhGetLanguage
'
Public Function AhGetLanguage(strLang As String) As Long
    AhGetLanguage = langRus ' default
    If Len(strLang) > 0 Then
        If (strLang = "english") Or (strLang = "eng") Or (strLang = "0") Then
            AhGetLanguage = langEng
        End If
    End If
End Function
'
' AhGetLanguageAsString
'
Public Function AhGetLanguageAsString() As String
    If lang_ = langEng Then
        AhGetLanguageAsString = "eng"
    Else
        AhGetLanguageAsString = "rus"
    End If
End Function
'
' AhDocStateSaverSwitch
'
Sub AhDocStateSaverSwitch()
    If WordObject.obj Is Nothing Then
        AhDocStateSaverInit
    Else
        AhDocStateSaverExit
    End If
End Sub
'
' AhDocStateSaverDialog
'
Sub AhDocStateSaverDialog()
    If WordObject.obj Is Nothing Then
        If cbOnDialogPressedInitPlugin Then
            AhDocStateSaverInit
        Else
            Exit Sub
        End If
    End If
    Dim dlg As AhDocStateSaverDocumentsForm
    Set dlg = New AhDocStateSaverDocumentsForm
    With dlg
        .InitDialogData
        .Show vbModal
        If dlg.dwDialogResult = vbOK Then
            ' do something terrible
        End If
        ' SaveItSelf
    End With
    Set dlg = Nothing
End Sub
'
' AhDocStateSaverRegDoc
'
Sub AhDocStateSaverRegDoc(aDoc As Document)
    ' assume this is called when document is closed
    ' add only documents with existing files
    Dim sFilePath As String
    sFilePath = aDoc.FullName
    Dim bExists As Boolean
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    bExists = fs.FileExists(sFilePath)
    Debug.Print "File <" & sFilePath & "> exists = " & bExists
    If bExists Then
        DocsColl.Register aDoc
    End If
    Set fs = Nothing
End Sub
'
' AhDocStateSaverNewDoc
'
Sub AhDocStateSaverNewDoc(aDoc As Document)
    ' apply default state to the new document
    DocDataDflt.ApplyTo aDoc, False
End Sub
'
' AhDocStateSaverOpenDoc
'
Sub AhDocStateSaverOpenDoc(aDoc As Document)
    ' assume this is called when document is opened
    Dim ind As Long
    ind = DocsColl.FindIndex4FilePath(aDoc.FullName)
    If ciNotFound = ind Then
        Debug.Print Replace(cStrDocNotFound, "%1", aDoc.FullName)
    Else
        Debug.Print Replace(cStrDocFound, "%1", aDoc.FullName)
        DocsColl.ApplyTo ind, aDoc
    End If
End Sub

 

Выводы

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

Создание плагина - шаг за шагом

Этот плагин был создан за пять шагов. Все они были сохранены. [217 Kb, ZIP, скачать].

"AhDocStateSaver-1.dot" - скелет.
"AhDocStateSaver-2.dot"  - коллекция документов находится в памяти.
"AhDocStateSaver-3.dot" - кнопка включения, форма "Документы". XML файл.
"AhDocStateSaver-4.dot" - добавлено состояние документа по умолчанию.
"AhDocStateSaver-5.dot" - окончательный вариант, который рассматривается в тексте.
 

 

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

 

Задание 1

Добавьте в сохраняемые параметры (модуль класса AhDocData) дату и время сохранения документа. Обеспечьте их заполнение при создании нового элемента класса, а также сохранение в файле XML и чтение из файла XML (модуль класса AhDocColl). Это потребуется для сортировки записей о документах при выполнении Задания 2.

Задание 2

Измените форму "Документы" (модуль формы AhDocStateSaverDocumentsForm) таким образом, чтобы появилась возможность удобной сортировки документов по имени и по времени сохранения. Используйте те элементы интерфейса пользователя, которые кажутся Вам наиболее удобными. Реализуйте алгоритм сортировки. Код, реализующий алгоритм сортировки пузырьком легко найти в сети.

 


Этюды для программистов Microsoft Word. Этюд 4.1. Сохранение состояния документов.

 


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