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

因工作需要，需要经常更新文档内容。每次更新后文件版本号等信息都需要一一更新，过于繁琐且容易遗漏。因为更新部分有统一的格式，考虑利用Word文件的自定义属性和域功能实现自动更新这些常规内容。

主要包括：文档名，版本号（在文件名中有统一命名规则），文档更新日期，更新人员，核查人员等。通过文件自定义属性/域/宏结合使用，可以很好的实现文件版本号自动更新的问题。

Modules代码：

Option ExplicitPublic posIssueNo As ByteSub Update()'' NS_New Macro' Macro created 03/08/2012 by Vico Song'    ''''''''''''''''''''''''''''''''''''''''''''    ''' Define variables  ''''''''''''''''''''''    ''''''''''''''''''''''''''''''''''''''''''''    Dim vProperties, vDefaultPropertyValue, vAuthors, vCheckers, v As Variant    Dim i, lenDocName As Integer    Dim b As Boolean    Dim s As String            ''''''''''''''''''''''''''''''''''''''''''''    ''' Initial variables  '''''''''''''''''''''    ''''''''''''''''''''''''''''''''''''''''''''    vProperties = Array("_DocuName", _                    "_IssueNumber", _                    "_Prepared/Modified", _                    "_Checked/Released", _                    "_UpdateDate")    vDefaultPropertyValue = Array("DD***xXXXXExx", _                    "xx", _                    "_AUTHOR_", _                    "_CHECKER_", _                    Date)    ''' Add author to the list below    vAuthors = Array("Luke Wang", _                    "Vico Song")    ''' add checker to the list below    vCheckers = Array("Jason Li", _                    "Kino Zhang", _                    "Larry Yu", _                    "Luke Wang", _                    "Sean Lee")    ''' Check the document name    lenDocName = Len(ActiveDocument.Name)    If lenDocName < 21 Then        MsgBox ("E01: The file name is not defined by NEW or COPE numbering system!")        Exit Sub    End If        If UCase(Left(ActiveDocument.Name, 2)) = "DD" And _      UCase(Mid(ActiveDocument.Name, 9, 1)) = "E" And _      IsNumeric(Mid(ActiveDocument.Name, 10, 2)) And _      IsNumeric(Mid(ActiveDocument.Name, 13, 2)) Then        posIssueNo = 13 ''' Numbering System NEW, file name like DDT10208E00_02-EN.doc    ElseIf UCase(Left(ActiveDocument.Name, 2)) = "DD" And _      UCase(Mid(ActiveDocument.Name, 11, 1)) = "E" And _      IsNumeric(Mid(ActiveDocument.Name, 12, 2)) And _      IsNumeric(Mid(ActiveDocument.Name, 15, 2)) Then        posIssueNo = 15 ''' Numbering System COPE, file name like DDDEP10402E13_21-EN.doc    Else        MsgBox ("E02: The file name is not defined by NEW or COPE numbering system!")        Exit Sub    End If        ''''''''''''''''''''''''''''''''''''''''''''    ''' Check and create document properties '''    ''''''''''''''''''''''''''''''''''''''''''''    If UBound(vProperties) = UBound(vDefaultPropertyValue) Then        For i = 0 To UBound(vProperties)            Call CreateProperty(vProperties(i), vDefaultPropertyValue(i))        Next    Else        MsgBox ("Error!!!" & vbCrLf & vbCrLf & "Please check VBA code!" & vbCrLf & vbCrLf & _            "Tip: UBound(vProperties) != UBound(vDefaultPropertyValue)")        Exit Sub    End If            ''''''''''''''''''''''''''''''''''''''''''''    ''' Initial components of frm_docInput   '''    ''''''''''''''''''''''''''''''''''''''''''''    b = False    s = ActiveDocument.CustomDocumentProperties("_Prepared/Modified")    frm_docInput.cmb_Author.Clear    For Each v In vAuthors        frm_docInput.cmb_Author.AddItem (v)        ''' set current default property value as combo box default value        If v = s Then            frm_docInput.cmb_Author.Value = v            b = True        End If    Next    ''' If current value of document property does not exist in the list,    ''' add it into list and set it as combo box default value    If Not b Then        frm_docInput.cmb_Author.AddItem (s)        frm_docInput.cmb_Author.Value = s    End If        b = False    s = ActiveDocument.CustomDocumentProperties("_Checked/Released")    frm_docInput.cmb_Checker.Clear    For Each v In vCheckers        frm_docInput.cmb_Checker.AddItem (v)        ''' set current default property value as combo box default value        If v = s Then            frm_docInput.cmb_Checker.Value = v            b = True        End If    Next    ''' If current value of document property does not exist in the list,    ''' add it into list and set it as combo box default value    If Not b Then        frm_docInput.cmb_Checker.AddItem (s)        frm_docInput.cmb_Checker.Value = s    End If    s = ActiveDocument.CustomDocumentProperties("_UpdateDate")    v = Date    frm_docInput.cmb_Date.Clear    If Not v = s Then frm_docInput.cmb_Date.AddItem (v)    frm_docInput.cmb_Date.AddItem (s)    frm_docInput.cmb_Date.Value = s        frm_docInput.txt_docNo = Left(ActiveDocument.Name, posIssueNo - 2)    frm_docInput.txt_issueNo = Mid(ActiveDocument.Name, posIssueNo, 2)    frm_docInput.ShowEnd SubPublic Sub CreateProperty(ByVal sPropertyName As String, ByVal sDefaultValue As String)'' CreateProperty Macro' Macro created 03/08/2012 by Vico Song'    Dim bExist As Boolean    Dim p As DocumentProperty        bExist = False    ''' Check all existed properties, if current property already exist    For Each p In ActiveDocument.CustomDocumentProperties        If p.Name = sPropertyName Then bExist = True    Next    ''' If current property does not exist, create.    If Not bExist Then        ActiveDocument.CustomDocumentProperties.Add _            Name:=sPropertyName, LinkToContent:=False, Value:=sDefaultValue, _            Type:=msoPropertyTypeString    End IfEnd Sub

窗体frm_docInput代码：

Option ExplicitPrivate Sub btn_Cancel_Click()    Unload MeEnd SubPrivate Sub btn_OK_Click()    ActiveDocument.CustomDocumentProperties("_DocuName") = frm_docInput.txt_docNo.Value    ActiveDocument.CustomDocumentProperties("_IssueNumber") = frm_docInput.txt_issueNo.Value    ActiveDocument.CustomDocumentProperties("_Prepared/Modified") = frm_docInput.cmb_Author.Value    ActiveDocument.CustomDocumentProperties("_Checked/Released") = frm_docInput.cmb_Checker.Value    ActiveDocument.CustomDocumentProperties("_UpdateDate") = frm_docInput.cmb_Date.Value        ActiveDocument.StoryRanges(wdFirstPageFooterStory).Fields.Update    ActiveDocument.StoryRanges(wdEvenPagesHeaderStory).Fields.Update    ActiveDocument.StoryRanges(wdPrimaryHeaderStory).Fields.Update        Unload MeEnd Sub

窗体界面：