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

Home ] Up ] Этюд 3.1. Работа со свойствами документа. ] Этюд 3.2. Переопределение поведения Drag-n-Drop для окна документа Microsoft Word ] Этюд 3.3. Microsoft Word как сервер автоматизации. ] Этюд 3.4. Транскрайбер ]


Этюд 3.1. Работа со свойствами документа

Задание. Свойства документа Microsoft Office.

Свойства документа Microsoft Office - это та информация, которую мы видим в диалоге "Свойства документа" Microsoft Word,  Microsoft Excel или в диалоге "Свойства" операционной системы Microsoft Windows.

Со свойствами документов Microsoft Office можно познакомиться в Приложении. [Читать!] Приведена информация о перечислениях msoDocProperties и WdBuiltInProperty. Рассматриваются также диалог Microsoft Word и диалог Microsoft Windows для работы со свойствами документа.

 

У каждого документа Microsoft Word есть набор встроенных (built-in) и пользовательских (custom) свойств. Часть встроенных свойств является редактируемой, другая часть - например, количество слов в документе, является вычисляемой и имеет атрибут "только для чтения" (read only).

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

Утилита "GetOLEProps.exe" (оконный интерфейс), написанная на языке C++, предназначена для экспорта свойств из документов Microsoft Word в файл формата XML.

Ресурсы

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

Утилита "GetOLEProps.exe" 108 Kb,  формат ZIP  [скачать].
Исходные тексты проекта GetOLEProps [позже!].

Страница утилиты "GetOLEProps.exe".

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

Задача

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

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

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

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

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

Макрос

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

Help

AhDocPropertiesHelp

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

Builtin Get

AhDocPropertiesTestBuiltinGet

Получение значений трёх встроенных свойств документа - "Title", "Comments" и "Keywords".

Custom Get

AhDocPropertiesTestCustomGet

Получение значения пользовательского свойства "NewProperty1".

Custom Set

AhDocPropertiesTestCustomSet

Установка значения пользовательского свойства "NewProperty1".

Custom Delete

AhDocPropertiesTestCustomDelete

Удаление пользовательского свойства "NewProperty1".

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

Получение значений встроенных свойств

Получение значений трёх встроенных свойств документа - "Title", "Comments" и "Keywords".

Получение значения пользовательского свойства

Получение значения пользовательского свойства "NewProperty1".

Установка значения пользовательского свойства

Установка значения пользовательского свойства "NewProperty1".

Удаление пользовательского свойства

Удаление пользовательского свойства "NewProperty1".

 

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

Рассмотрим функции, предназначенные для работы с пользовательскими и встроенными свойствами документа. Функции расположены в модуле "AhDocProperties" шаблона "AhDocProperties.dot".

Краткое описание функций приведено в следующей таблице.

Функция

Комментарий

AhCustPropertyGet

Получение пользовательского свойства.

AhCustPropertySet

Установка пользовательского свойства.

AhCustPropertyDelete

Удаление пользовательского свойства.

AhDocumentPropertyGet

Получение встроенного свойства.

 

'
' Constants
'
Private Const cbForceSaveAfterPropertyChange As Boolean = False
Private Const strNewPropertyName As String = "NewProperty1"

Подсказка

'
' AhDocPropertiesHelp
'
Sub AhDocPropertiesHelp()
MsgBox "Etudes for Microsoft Word Programmers." & vbCrLf & vbCrLf & _
"Etude 3.1. Document Properties." & vbCrLf & _
" © 2000-2008. Evgeny Akhundzhanov. All rights reserved worldwide." & vbCrLf & _
"http://www.transcriber.ru" & vbCrLf & vbCrLf & _
"Template 'AhDocProperties.dot' - " & vbCrLf & vbCrLf & _
"Builtin Get - gets builtin document properties" & vbCrLf & _
"Custom Get - gets custom document properties" & vbCrLf & _
"Custom Set - sets custom document properties" & vbCrLf & _
"Custom Delete - deletes custom document properties"
End Sub
 

Функция AhCustPropertyGet

Функция AhCustPropertyGet предназначена для получения пользовательского свойства документа. Возвращает True в случае если требуемое свойство найдено и False в противном случае.

'
' AhCustPropertyGet
'
Function AhCustPropertyGet(ByVal Doc As Document, ByVal strPropName As String, ByRef varPropValue As Variant) As Boolean
Dim bFound As Boolean
Dim strName As String
Dim strValue As String

Dim intTag As Long
   
    bFound = False
    Set varPropValue = Nothing
   
    For intTag = 1 To Doc.CustomDocumentProperties.Count
        strName = Doc.CustomDocumentProperties.Item(intTag).Name
        If strName = strPropName Then
            varPropValue = Doc.CustomDocumentProperties.Item(intTag).Value
            bFound = True
            Exit For
        End If
    Next intTag
   
    AhCustPropertyGet = bFound
   
End Function

Процедура AhCustPropertySet

Процедура AhCustPropertySet предназначена для установки пользовательского свойства документа.

'
' AhCustPropertySet
'
Sub AhCustPropertySet(ByVal Doc As Document, ByVal strPropName As String, ByVal varPropValue As Variant, ByVal dwPropType As Long, ByVal bForceSave As Boolean)
Dim bFound As Boolean
Dim strName As String
Dim strValue As String
Dim intTag As Long
 
    bFound = False
   
    For intTag = 1 To Doc.CustomDocumentProperties.Count
        strName = Doc.CustomDocumentProperties.Item(intTag).Name
        If strName = strPropName Then
            Doc.CustomDocumentProperties.Item(intTag).Value = varPropValue
            bFound = True
            Exit For
        End If
    Next intTag

   
    If Not bFound Then
        Doc.CustomDocumentProperties.Add Name:=strPropName, LinkToContent:=False, _
        Type:=dwPropType, Value:=varPropValue   ' msoPropertyTypeString
    End If
   
    If bForceSave Then
        Doc.Saved = False
        ' Doc.Save
    End If
    
End Sub

Процедура AhCustPropertyDelete

Процедура AhCustPropertyDelete предназначена для удаления пользовательского свойства документа.

'
' AhCustPropertyDelete
'
Sub AhCustPropertyDelete(ByVal Doc As Document, ByVal strPropName, ByVal bForceSave As Boolean)
   
    Dim intTag As Long
    Dim strName As String
    For intTag = 1 To Doc.CustomDocumentProperties.Count
        strName = Doc.CustomDocumentProperties.Item(intTag).Name
        If strName = strPropName Then
            Doc.CustomDocumentProperties.Item(intTag).Delete
            Exit For
        End If
    Next intTag
 
    If bForceSave Then
        Doc.Saved = False
        ' Doc.Save
    End If
 
End Sub

 

Функция AhDocumentPropertySet

Функция AhDocumentPropertySet предназначена для установки значения встроенного свойства документа.

'
' AhDocumentPropertySet
'
Function AhDocumentPropertySet(ByVal Doc As Document, ByVal wdProperty As Long, ByVal varValue As Variant) As Boolean
    Dim strValue As String
    Dim proDoc As DocumentProperty
   
    With Doc.BuiltInDocumentProperties
        On Error GoTo ErrorLabel
        .Item(wdProperty) = varValue
    End With
   
    AhDocumentPropertySet = True
    Exit Function
   
ErrorLabel:
    AhDocumentPropertySet = False
End Function

Установка встроенных свойств для всех документов в заданной папке

Для тестирования функции AhDocumentPropertySet была написана процедура AhTestDocumentPropertySet и функция AhGetFilesInFolder. Функция AhGetFilesInFolder возвращает список файлов, имена которых удовлетворяют заданному шаблону (wildcards), заполняя именами файлов динамический массив.

'
' AhGetFilesInFolder
'
Private Function AhGetFilesInFolder(ByVal strWildCard As String, arrFile() As String) As Long
Dim aFile As String
Dim nFile As Long
    nFile = 0
    aFile = Dir$(strWildCard)
    Do While aFile <> ""
        arrFile(nFile) = aFile
        aFile = Dir$
        nFile = nFile + 1
    Loop
   
    'Reset the size of the array without losing its values by using Redim Preserve
    ReDim Preserve arrFile(nFile - 1)
    AhGetFilesInFolder = nFile
End Function

Процедура AhTestDocumentPropertySet

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

'
' AhTestDocumentPropertySet
'
Sub AhTestDocumentPropertySet()
Dim nFile As Long
Dim nFiles As Long
Dim strFolder As String
Dim strExtension As String
Dim strWildCard As String
Dim arrFile() As String    ' dynamic array
ReDim arrFile(128)         ' initial size
    strFolder = "D:\AhMSWord\Book"
   
strFolder = strFolder + "\"
    strExtension = "*.doc"
    strWildCard = strFolder + strExtension
   
    nFiles = AhGetFilesInFolder(strWildCard, arrFile)
 
    Debug.Print "Wildcard is <" & strWildCard & ">. Files found = " & nFiles
   
    '
    ' List collected files
    '
    For nFile = 0 To UBound(arrFile)
        Debug.Print arrFile(nFile)
    Next nFile
    Debug.Print vbCrLf
   
    '
    ' Process collected files
    '
    ChangeFileOpenDirectory strFolder
   
    For nFile = 0 To UBound(arrFile)
        Debug.Print "Processing " & arrFile(nFile)
   
        Documents.Open FileName:=arrFile(nFile), ConfirmConversions:=False, ReadOnly:= _
            False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:= _
            "", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="", _
            Format:=wdOpenFormatAuto
           
        AhDocumentPropertySet(ActiveDocument, wdPropertyTitle, "
Использование Microsoft Word в программных проектах")
        AhDocumentPropertySet(ActiveDocument, wdPropertySubject, "SUBJECT here...")
        AhDocumentPropertySet(ActiveDocument, wdPropertyAuthor, "Evgeny Akhundzhanov")
        AhDocumentPropertySet(ActiveDocument, wdPropertyManager, "
Евгений Ахунджанов")
        AhDocumentPropertySet(ActiveDocument, wdPropertyCompany, "Private")

        AhDocumentPropertySet(ActiveDocument, wdPropertyCategory, "BOO")
        AhDocumentPropertySet(ActiveDocument, wdPropertyKeywords, "Microsoft Word, VBA, Macros, C++, Software projects")
        AhDocumentPropertySet(ActiveDocument, wdPropertyComments, "© 2001-2006,
Евгений Ахунджанов®. Все права сохранены.")
       
        ActiveDocument.Save
        ActiveDocument.Close
       
    Next nFile
    Debug.Print vbCrLf
End Sub

Функция AhDocumentPropertyGet

Функция AhDocumentPropertyGet предназначена для получения значения встроенного свойства документа.

'
' AhDocumentPropertyGet
'
Function AhDocumentPropertyGet(ByVal Doc As Document, ByVal wdProperty As Long) As String
    Dim strValue As String
    Dim proDoc As DocumentProperty
    With Doc.BuiltInDocumentProperties
        Set proDoc = .Item(wdProperty)
        strValue = proDoc.Value
    End With
    AhDocumentPropertyGet = strValue
End Function

Функции AhDocPropertyGetAnyB и AhDocPropertyGetAnyC

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

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

'
' AhDocPropertyGetAnyB  (BuiltIn property has a priority)
'
Function AhDocPropertyGetAnyB(strPropName As String) As Variant
Dim varValue As Variant ' for debugging
    '
    ' try to get built-in property first
    '
    On Error GoTo LabelTryCustom
    varValue = ActiveDocument.BuiltInDocumentProperties(strPropName).Value
    AhDocPropertyGetAnyB = varValue
    Exit Function
 
LabelTryCustom:
    '
    ' on error try to get custom property
    '
    Err.Clear
    varValue = ActiveDocument.CustomDocumentProperties(strPropName).Value
    AhDocPropertyGetAnyB = varValue
    Exit Function
    '
    ' on error return empty string
    '

    AhDocPropertyGetAnyB = ""
End Function

 

'
' AhDocPropertyGetAnyC (Custom property has a priority)
'
Function AhDocPropertyGetAnyC(strPropName As String) As Variant
Dim varValue As Variant ' for debugging
    '
    ' try to get custom property first
    '

    On Error GoTo LabelTryBuiltIn
    varValue = ActiveDocument.CustomDocumentProperties(strPropName).Value
    AhDocPropertyGetAnyC = varValue
    Exit Function
 
LabelTryBuiltIn:
    '
    ' on error try to get built-in property
    '
    Err.Clear
    varValue = ActiveDocument.BuiltInDocumentProperties(strPropName).Value
    AhDocPropertyGetAnyC = varValue
    Exit Function
    '
    ' on error return empty string
   
'
   
AhDocPropertyGetAnyC = ""
End Function

Тестирование функции AhDocPropertyGetAny

'
' AhDocPropertyTestGetAny
'
Sub AhDocPropertyTestGetAny()
Dim strPropName As String
Dim strPropVal As String
    strPropName = "Author"
    '
    ' Prepare document with custom Property "Author"
    ' Run this Test macro.
    ' AhDocPropertyGetAnyB("Author") will always return built-in Author
    ' AhDocPropertyGetAnyC("Author") will return custom Author, if it exists.
    '
  strPropVal = AhDocPropertyGetAnyB(strPropName)
  Debug.Print strPropName & " = <" & strPropVal & ">."
  strPropVal = AhDocPropertyGetAnyC(strPropName)
  Debug.Print strPropName & " = <" & strPropVal & ">."
 
End Sub

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

Если программно добавить или изменить свойства документа и закрыть файл, не применяя команду "Сохранить/Save", то после закрытия документа свойства документа не будут сохранены. Для сохранения измененных свойств следует использовать следующий код:

    ActiveDocument.Saved = False
    On Error Resume Next
    ActiveDocument.Save

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

В приведенных выше функциях документ помечается как несохраненный, а сохранение документа закомментировано.

Процедура AhDocPropertiesTestBuiltinGet

'
' AhDocPropertiesTestBuiltinGet
'
Sub AhDocPropertiesTestBuiltinGet()
If Documents.Count = 0 Then Exit Sub
Dim strReport As String
Dim prop1 As Variant
Dim prop2 As Variant
Dim prop3 As Variant
    prop1 = AhDocumentPropertyGet(ActiveDocument, wdPropertyTitle)
    prop2 = AhDocumentPropertyGet(ActiveDocument, wdPropertyComments)
    prop3 = AhDocumentPropertyGet(ActiveDocument, wdPropertyKeywords)
    strReport = "Title    = <" & prop1 & ">" & Chr(13) & _
                "Comments = <" & prop2 & ">" & Chr(13) & _
                "Keywords = <" & prop3 & ">"
    MsgBox strReport

End Sub

Процедура AhDocPropertiesTestCustomGet

'
' AhDocPropertiesTestCustomGet
'
Sub AhDocPropertiesTestCustomGet()
If Documents.Count = 0 Then Exit Sub
Dim varPropValue As Variant
Dim strReport As String
    If AhCustPropertyGet(ActiveDocument, strNewPropertyName, varPropValue) Then
        strReport = "Property <" & strNewPropertyName & "> =  <" & varPropValue & ">."
    Else
        strReport = "Property <" & strNewPropertyName & "> was not found."
    End If
    MsgBox strReport
End Sub

Процедура AhDocPropertiesTestCustomSet

'
' AhDocPropertiesTestCustomSet
'
Sub AhDocPropertiesTestCustomSet()
If Documents.Count = 0 Then Exit Sub
 
Dim strPropName As String
Dim varPropValue As Variant
    strPropName = strNewPropertyName

    varPropValue = "123"
    AhCustPropertySet ActiveDocument, strPropName, varPropValue, msoPropertyTypeString, cbForceSaveAfterPropertyChange
 
    '
    ' report
    '
    Dim strReport As String
    strReport = "Property <" & strNewPropertyName & "> was set to <" & varPropValue & ">."
    If cbForceSaveAfterPropertyChange Then
        strReport = strReport + Chr(13) + "Document was marked as not saved."
    Else
        strReport = strReport + Chr(13) + "Document was not marked."
    End If
    MsgBox strReport
   
End Sub

Процедура AhDocPropertiesTestCustomDelete

'
' AhDocPropertiesTestCustomDelete
'
Sub AhDocPropertiesTestCustomDelete()
If Documents.Count = 0 Then Exit Sub
   
    On Error Resume Next
    AhCustPropertyDelete ActiveDocument, strNewPropertyName, cbForceSaveAfterPropertyChange
   
    '
    ' report
    '
    Dim strReport As String
    strReport = "Property <" & strNewPropertyName & "> was deleted."
    If cbForceSaveAfterPropertyChange Then
        strReport = strReport + Chr(13) + "Document was marked as not saved."
    Else
        strReport = strReport + Chr(13) + "Document was not marked."
    End If
    MsgBox strReport
   
End Sub

Выводы

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

Задание 1

Рассмотренный выше шаблон содержит макрос AhTestDocumentPropertySet, с помощью которого можно установить ряд встроенных свойств для всех документов Microsoft Word в заданной папке.

Макрос AhTestDocumentPropertySet можно вызвать только вручную из редактора VBA.

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

 

Задание 2

В каждом документе Microsoft Word помимо набора свойств имеется коллекция переменных (Variables). Коллекция переменных сохраняется в файле документа. В отличие от свойств документа, для переменных не предусмотрено никаких команд меню или диалогов для просмотра и редактирования. Поэтому с переменными можно работать только программно.

Создайте шаблон AhDocVariables.dot, содержащий панель инструментов AhDocVariables и макросы для работы с переменными документа.

Поэкспериментируйте с написанными макросами.

 

 


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


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