用Word宏实现自动递增

在Word 97-2003中,可以通过转到“文件/属性”,选择“自定义”选项卡并在其中指定名称和值来添加自定义属性。在Word 2007中添加自定义文档属性有点隐晦,我想这是“Office按钮/准备/文档属性”,选择“高级属性”的小下拉框,您将获得相同的ol'pre-2007对话框。

在下面的示例中,我简单地将我的名为“DocumentID”,并将其初始值指定为零。

ThisDocument.CustomDocumentProperties("DocumentID").Value = NewValue

作为概念证明,我创建了一个.dot文件,并在Document_New()事件中使用了以下代码:

Sub UpdateTemplate()

    Dim Template    As Word.Document
    Dim NewDoc      As Word.Document
    Dim DocumentID  As DocumentProperty
    Dim LastID      As Integer
    Dim NewID       As Integer

    'Get a reference to the newly created document
    Set NewDoc = ActiveDocument

    'Open the template file
    Set Template = Application.Documents.Open("C:\Doc1.dot")

    'Get the custom document property
    Set DocumentID = Template.CustomDocumentProperties("DocumentID")

    'Get the current ID
    LastID = DocumentID.Value

    'Use any method you need for determining a new value
    NewID = LastID + 1

    'Update and close the template
    Application.DisplayAlerts = wdAlertsNone
    DocumentID.Value = NewID
    Template.Saved = False
    Template.Save
    Template.Close

    'Remove references to the template
    NewDoc.AttachedTemplate = NormalTemplate

    'Add your ID to the document somewhere
    NewDoc.Range.InsertAfter ("The documentID for this document is " & NewID)
    NewDoc.CustomDocumentProperties("DocumentID").Value = NewID

End Sub

您可以完全通过使用Word和Excel的VBA来处理这个问题(我想也可以使用Access,但我对使用Access有一种不自然的反感)。

首先,创建一个新的Excel工作簿,并将其存储在可以通过word文档访问的位置(我的是C:\Desktop\Book1.xls)。您甚至可能希望通过在单元格A1中输入一个数值来设定值的种子。

在word文档中,您可以将其输入到文档_Open()子例程中:

Private Sub Document_Open()

Dim xlApp       As Excel.Application
Dim xlWorkbook  As Excel.Workbook
Dim xlRange     As Excel.Range
Dim sFile       As String
Dim LastID      As Integer
Dim NewID       As Integer

'Set to the location of the Excel "database"
sFile = "C:\Desktop\Book1.xls"

'Set all the variables for the necessary XL objects
Set xlApp = New Excel.Application
Set xlWorkbook = xlApp.Workbooks.Open(sFile)

'The used range assumes just one column in the first worksheet
Set xlRange = xlWorkbook.Worksheets(1).UsedRange

'Use a built-in Excel function to get the max ID from the used range
LastID = xlApp.WorksheetFunction.Max(xlRange)

'You may want to come up with some crazy algorithm for
'this, but I opted for the intense + 1
NewID = LastID + 1

'This will prevent the save dialog from prompting the user
xlApp.DisplayAlerts = False

'Add your ID somewhere in the document
ThisDocument.Range.InsertAfter (NewID)

'Add the new value to the Excel "database"
xlRange.Cells(xlRange.Count + 1, 1).Value = NewID

'Save and close
Call xlWorkbook.Save
Call xlWorkbook.Close

'Clean Up
xlApp.DisplayAlerts = True
Call xlApp.Quit
Set xlWorkbook = Nothing
Set xlApp = Nothing
Set xlRange = Nothing

End Sub

希望有帮助!

将数据库用于一个数字是过分的。

不经意间:

• 使用Excel作为具有自动化功能的外部数据库。
• 探索几个 SQLite COM wrappers

DOCID文件只有一个编号:最后一个实际使用的ID。

A) 读取文件(不是在写入/追加模式下)并将其存储在文档DOC\u ID=file\u ID+1的变量上,然后保存文档。暂时关闭DOCID文件,打开/创建文件以进行读写操作,关闭文件。如果一切顺利,包括接近,你是安全的,否则,回到A)。

我太累了,无法检查它是否会在并发场景下创建死锁。。。可能吧。

似乎我找到了一种方法来打开和更新具有独占权限的文本文件,这意味着不会出现并发问题:

Private Function GetNextID(sFile As String) As Integer
    Dim nFile As Integer

    nFile = FreeFile

    On Error Resume Next
    Open sFile For Binary Access Read Write Lock Read Write As #nFile
    If Err.Number <> 0 Then
        ' Return -1 if the file couldn't be opened exclusively
        GetNextID = -1
        Err.Clear
        Exit Function
    End If
    On Error GoTo 0

    GetNextID = 1 + Val(Input(LOF(nFile), #nFile))
    Put #nFile, 1, CStr(GetNextID)
    Close #nFile
End Function