使用Word宏实现自动增量

时间:2009-04-08 13:38:15

标签: vba word-vba

我正在为文档模板编写Word / VBA宏。每次用户从模板中保存/创建新文档时,文档都需要在文本中嵌入ID。我怎样(尽可能简单)为此ID实现自动增量? ID是数字。

系统必须有某种机制来避免不同的文档获得相同的ID,但负载非常低。大约20人将使用此模板(在我们的内部网上),每周创建20个新文档。

我已经想到了一个可以从宏中锁定和解锁的文本文件,或者使用SQLite数据库调用PHP页面,但还有其他更智能的解决方案吗?

请注意,我不能使用UUID或GUID,因为人和设备都需要使用ID。我们的客户必须能够通过电话说:“......然后,凭借ID 436 ......?”

6 个答案:

答案 0 :(得分:3)

进一步考虑到了这一点,这是您可能想要考虑的另一种方法。如果您对以前的ID目录不感兴趣,那么您只需使用自定义文档属性来存储使用的最后一个ID。

在Word 97-2003中,您可以通过转到“文件/属性”,选择自定义选项卡并在其中指定名称和值来添加自定义属性。在Word 2007中添加自定义文档属性更加隐蔽,我认为这是“Office按钮/准备/文档属性”,选择高级属性的小下拉框,你会得到相同的ol'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
祝你好运!

答案 1 :(得分:2)

你可以通过VBA使用Word和Excel完全处理这个问题(或者我认为是Access,但我对使用Access有一种不自然的厌恶)。

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

在word文档中,您可以将其输入Document_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

我意识到这是一个很高的程序,所以无论如何都要重新考虑它的内容。这只是我掀起的一个快速测试。此外,您还需要通过VBA中的引用添加对Excel对象库的引用。如果您对该如何运作有任何疑问,请与我们联系。

希望有所帮助!

答案 2 :(得分:1)

嗯,你必须在某个地方存储下一个身份证号码。文本文件的想法和任何一样好。您只需处理由于某种原因被锁定或无法访问的可能性。

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

答案 3 :(得分:1)

脱离我的头顶:

  • 使用Excel作为带自动化的外部数据库。
  • 探索几个SQLite COM wrappers(想起Litex)。

答案 4 :(得分:0)

“我从宏中锁定和解锁的文本文件”将是最安全的方法。 DOCID文件只有一个数字:最后一个实际使用的ID。

A)您读取文件(不是写入/追加模式)并存储在文档DOC_ID = FILE_ID + 1上的变量上并保存文档。暂时你杀了DOCID文件,打开/创建读写来输入你的DOC_ID。关闭文件。如果一切顺利,包括关闭,那么你是安全的,否则,回到A)。

您可能需要考虑:如果找不到文件,请使用此文档ID +100创建它,作为在A)中从无UPS灾难恢复的措施

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

如果你觉得它值得,我可以把代码放在这里。

答案 5 :(得分:0)

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

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

只需调用此函数,直到它不再返回-1。整齐。

相关问题