Реализовать автоинкремент с помощью макроса Word

Еще немного подумал об этом, и вот еще один подход, который вы, возможно, захотите рассмотреть. Если вас не интересует каталог предыдущих идентификаторов, вы можете просто использовать настраиваемое свойство документа для хранения последнего использованного идентификатора.

В Word 97-2003 можно добавить пользовательское свойство, перейдя в «Файл/Свойства», выбрав вкладку «Пользовательское» и назначив там имя и значение. Добавление пользовательского свойства документа в Word 2007 немного более скрыто и не приходит мне в голову, я думаю, что это «Кнопка Office / Подготовка / Свойства документа», выберите небольшой раскрывающийся список для дополнительных свойств, и вы получите то же самое старый диалог до 2007 года.

В приведенном ниже примере я назвал свой просто «ID документа» и присвоил ему начальное значение, равное нулю.

Соответствующий фрагмент кода для обновления пользовательского свойства документа:

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

Удачи!

Вы можете полностью справиться с этим через VBA, используя Word и Excel (или Access, я полагаю, но у меня неестественное отвращение к использованию Access).

Во-первых, создайте новую книгу Excel и сохраните ее в месте, к которому вы можете получить доступ через документ Word (у меня это C:\Desktop\Book1.xls). Вы даже можете захотеть заполнить значения, введя числовое значение в ячейку A1.

В вашем текстовом документе вы должны ввести это в свою подпрограмму 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

Я понимаю, что это трудоемкая процедура, поэтому во что бы то ни стало переделайте ее как душе угодно. Это был просто быстрый тест, который я приготовил. Кроме того, вам нужно будет добавить ссылку на библиотеку объектов Excel через ссылки в VBA. Дайте мне знать, если у вас есть какие-либо вопросы о том, как это работает.

Надеюсь, это поможет!

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

Использование базы данных для одного номера — это излишество.

С верхней части моей головы:

• Используйте Excel в качестве внешней базы данных с автоматизацией.
• Изучите несколько оболочек SQLite COM (на ум приходит Litex).

«текстовый файл, который я блокирую и разблокирую из макроса», был бы самым безопасным подходом. Файл DOCID будет иметь только один номер: последний ДЕЙСТВИТЕЛЬНО использованный идентификатор.

A) Вы читаете файл (не в режиме записи/добавления) и сохраняете переменную в своем документе DOC_ID =FILE_ID+1 и сохраняете документ. Ориентировочно вы убиваете файл DOCID, открываете/создаете для чтения-записи, составляя свой DOC_ID. Закройте файл. Если все прошло хорошо, включая Close, вы в безопасности, в противном случае вернитесь к A).

Возможно, вы захотите рассмотреть следующее: если файл не найден, создайте его с идентификатором этого документа +100 в качестве меры восстановления после сбоев без ИБП во время 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

Просто вызывайте эту функцию до тех пор, пока она не перестанет возвращать -1. Аккуратный.