Word 使用宏根据文件名实现文件版本号自动更新_rev00

利用Word宏功能实现文件版本号及相关内容自动更新，最初版。

实现功能：通过Word文件自定义属性结合域和宏实现自动更新文件相关信息，包括：

通过InputBox输入作者/核查/更新日期；

通过文件名获取文档编码和文件版本号。

另外通过几个自定义宏可以实现快速域插入以及文档特殊标记符号的显示和隐藏。

Attribute VB_Name = "Docu"
Sub NS_New()
'
' NS_New Macro
' Macro created 02/22/2012 by songv
'
''''''''''''''''''''''''''''''''''''''''''''
''' Define variables  ''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    Dim docuName, author, checker, issueNumber, updateInfo, date1 As String
    Dim result As Integer


''''''''''''''''''''''''''''''''''''''''''''
''' Initial variables  '''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    docuName = "DDXXXXxxxxExx"
    issueNumber = "00"
    On Error GoTo errHandler06
        author = ActiveDocument.CustomDocumentProperties("_Prepared/Modified")
    On Error GoTo errHandler07
        checker = ActiveDocument.CustomDocumentProperties("_Checked/Released")
    On Error GoTo errHandler08
        date1 = ActiveDocument.CustomDocumentProperties("_UpdateDate")
    result = 0
''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''
''' Get update information  ''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    On Error GoTo errHandler00
    '''get document name and issue number from file name, only valid for numbering system NEW
    '''for numbering system COPE and OLD, you should change 11 and 13 to correct number
    docuName = Left(ActiveDocument.Name, 11)
    issueNumber = Mid(ActiveDocument.Name, 13, 2)
    
    author = InputBox("Please input the author (prepared / modified)", "Input Author: ", author)
    '''StrPtr will check the variable address in memory,
    '''StrPtr(author) = 0 means it does not exist in memory, it is NULL.
    '''This confirms user pressed Cancel button.
    If author = "" And StrPtr(author) = 0 Then
        Exit Sub
    End If
    
    checker = InputBox("Please input the checker (checked / released)", "Input Checker: ", checker)
    If checker = "" And StrPtr(checker) = 0 Then
        Exit Sub
    End If
    
    date1 = InputBox("Please input the update date:", "Input Date: ", date1)
    If date1 = "" And StrPtr(date1) = 0 Then
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''
''' Confirm update information  ''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    updateInfo = "Update information:" & vbCrLf & vbCrLf & _
        "Document name    " & vbTab & ":  " & docuName & vbCrLf & _
        "Issue number     " & vbTab & ":  " & issueNumber & vbCrLf & _
        "Prepared/modified" & vbTab & ":  " & author & vbCrLf & _
        "Checked/released " & vbTab & ":  " & checker & vbCrLf & _
        "Update date      " & vbTab & ":  " & date1 & vbCrLf & vbCrLf & vbCrLf & _
        "Please confirm to update the document."

    result = MsgBox(updateInfo, vbYesNo, "Confirm to update the document")

    If (result = 6) Then
        ''' Update custom properties
        On Error GoTo errHandler01
            ActiveDocument.CustomDocumentProperties("_DocuName") = docuName
        On Error GoTo errHandler02
            ActiveDocument.CustomDocumentProperties("_IssueNumber") = issueNumber
        On Error GoTo errHandler03
            ActiveDocument.CustomDocumentProperties("_Prepared/Modified") = author
        On Error GoTo errHandler04
            ActiveDocument.CustomDocumentProperties("_Checked/Released") = checker
        On Error GoTo errHandler05
            ActiveDocument.CustomDocumentProperties("_UpdateDate") = date1
        
        ''' resume error handler
        On Error GoTo errHandler00

        '''update all fields, for TOC field, this will only update page number.
        Dim aField As Field
        For Each aStory In ActiveDocument.StoryRanges
           For Each aField In aStory.Fields
              aField.Update
           Next aField
        Next aStory
    End If

    Exit Sub
    
errHandler00:
    MsgBox Err.Description

''''''''''''''''''''''''''''''''''''''''''''
''' Create custom properties '''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
'''if custom properties cannot be updated(do not exist), create relevant properties
errHandler01:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_DocuName", LinkToContent:=False, Value:=docuName, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler02:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_IssueNumber", LinkToContent:=False, Value:=issueNumber, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler03:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_Prepared/Modified", LinkToContent:=False, Value:=author, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler04:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_Checked/Released", LinkToContent:=False, Value:=checker, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler05:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_UpdateDate", LinkToContent:=False, Value:=date1, _
        Type:=msoPropertyTypeString
    Resume Next
''''''''''''''''''''''''''''''''''''''''''''

'''variable initializing when custom properties do not exist in current document
errHandler06:
    author = "_AUTHOR_"
    Resume Next
errHandler07:
    checker = "_CHECKER_"
    Resume Next
errHandler08:
    date1 = Date
    Resume Next

End Sub

Sub NS_Cope()
'
' NS_Cope Macro
' Macro created 02/22/2012 by songv
'
''''''''''''''''''''''''''''''''''''''''''''
''' Define variables  ''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    Dim docuName, author, checker, issueNumber, updateInfo, date1 As String
    Dim result As Integer


''''''''''''''''''''''''''''''''''''''''''''
''' Initial variables  '''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    docuName = "DDXXXXxxxxExx"
    issueNumber = "00"
    On Error GoTo errHandler06
        author = ActiveDocument.CustomDocumentProperties("_Prepared/Modified")
    On Error GoTo errHandler07
        checker = ActiveDocument.CustomDocumentProperties("_Checked/Released")
    On Error GoTo errHandler08
        date1 = ActiveDocument.CustomDocumentProperties("_UpdateDate")
    result = 0
''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''
''' Get update information  ''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    On Error GoTo errHandler00
    '''get document name and issue number from file name, only valid for numbering system COPE
    '''for numbering system NEW and OLD, you should change 13 and 15 to correct number
    docuName = Left(ActiveDocument.Name, 13)
    issueNumber = Mid(ActiveDocument.Name, 15, 2)
    
    author = InputBox("Please input the author (prepared / modified)", "Input Author: ", author)
    '''StrPtr will check the variable address in memory,
    '''StrPtr(author) = 0 means it does not exist in memory, it is NULL.
    '''This confirms user pressed Cancel button.
    If author = "" And StrPtr(author) = 0 Then
        Exit Sub
    End If
    
    checker = InputBox("Please input the checker (checked / released)", "Input Checker: ", checker)
    If checker = "" And StrPtr(checker) = 0 Then
        Exit Sub
    End If
    
    date1 = InputBox("Please input the update date:", "Input Date: ", date1)
    If date1 = "" And StrPtr(date1) = 0 Then
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''


''''''''''''''''''''''''''''''''''''''''''''
''' Confirm update information  ''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
    updateInfo = "Update information:" & vbCrLf & vbCrLf & _
        "Document name    " & vbTab & ":  " & docuName & vbCrLf & _
        "Issue number     " & vbTab & ":  " & issueNumber & vbCrLf & _
        "Prepared/modified" & vbTab & ":  " & author & vbCrLf & _
        "Checked/released " & vbTab & ":  " & checker & vbCrLf & _
        "Update date      " & vbTab & ":  " & date1 & vbCrLf & vbCrLf & vbCrLf & _
        "Please confirm to update the document."
        
    result = MsgBox(updateInfo, vbYesNo, "Confirm to update the document")

    If (result = 6) Then
        ''' Update custom properties
        On Error GoTo errHandler01
            ActiveDocument.CustomDocumentProperties("_DocuName") = docuName
        On Error GoTo errHandler02
            ActiveDocument.CustomDocumentProperties("_IssueNumber") = issueNumber
        On Error GoTo errHandler03
            ActiveDocument.CustomDocumentProperties("_Prepared/Modified") = author
        On Error GoTo errHandler04
            ActiveDocument.CustomDocumentProperties("_Checked/Released") = checker
        On Error GoTo errHandler05
            ActiveDocument.CustomDocumentProperties("_UpdateDate") = date1
        
        ''' resume error handler
        On Error GoTo errHandler00

        '''update all fields, for TOC field, only update page number.
        Dim aField As Field
        For Each aStory In ActiveDocument.StoryRanges
           For Each aField In aStory.Fields
              aField.Update
           Next aField
        Next aStory
    End If

    Exit Sub
    
errHandler00:
    MsgBox Err.Description

''''''''''''''''''''''''''''''''''''''''''''
''' Create custom properties '''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''
'''if custom properties cannot be updated(do not exist), create relevant properties
errHandler01:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_DocuName", LinkToContent:=False, Value:=docuName, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler02:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_IssueNumber", LinkToContent:=False, Value:=issueNumber, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler03:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_Prepared/Modified", LinkToContent:=False, Value:=author, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler04:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_Checked/Released", LinkToContent:=False, Value:=checker, _
        Type:=msoPropertyTypeString
    Resume Next
errHandler05:
    ActiveDocument.CustomDocumentProperties.Add _
        Name:="_UpdateDate", LinkToContent:=False, Value:=date1, _
        Type:=msoPropertyTypeString
    Resume Next
''''''''''''''''''''''''''''''''''''''''''''

'''variable initializing when custom properties do not exist in current document
errHandler06:
    author = "_AUTHOR_"
    Resume Next
errHandler07:
    checker = "_CHECKER_"
    Resume Next
errHandler08:
    date1 = Date
    Resume Next

End Sub
Sub IssueNo()
'
' InsertIssueNo Macro
' Macro recorded 02/22/2012 by songv
'
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DOCPROPERTY  _IssueNumber ", PreserveFormatting:=True
End Sub
Sub UpdateDate()
'
' InsertUpdateDate Macro
' Macro recorded 02/22/2012 by songv
'
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DOCPROPERTY  _UpdateDate ", PreserveFormatting:=True
End Sub
Sub author()
'
' InsertAuthor Macro
' Macro recorded 02/22/2012 by songv
'
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DOCPROPERTY  _Prepared/Modified ", PreserveFormatting:=True
End Sub
Sub checker()
'
' InsertChecker Macro
' Macro recorded 02/22/2012 by songv
'
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DOCPROPERTY  _Checked/Released ", PreserveFormatting:=True
End Sub
Sub docuName()
'
' InsertDocuName Macro
' Macro recorded 02/22/2012 by songv
'
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "DOCPROPERTY  _DocuName ", PreserveFormatting:=True
End Sub

Sub ShowAll()
'
' ShowAll Macro
' Macro created 02/29/2012 by songv
'
    ActiveWindow.View.ShowAll = True
End Sub
Sub HideAll()
'
' ShowAll Macro
' Macro created 02/29/2012 by songv
'
    ActiveWindow.View.ShowAll = False
End Sub