Automatically numbering many identical documents in Word with a little help from VBA

So, come in to work today and I am asked to produce 83 Exhibit Note Certificates. 83. I cannot palm this off because the admin assistant is off sick with the flu, and I cannot push the task back any further because the affidavit and its exhibits are due today.

I’m going to be busy enough engrossing and witnessing the affidavit, sorting out the actual exhibits, and certifying each Exhibit Note.

So I think, what is the quickest way of producing these documents? It’s for New South Wales, and unlike here, I don’t actually have to describe each document on the face of each Exhibit Note…the only variable then is the exhibit number…and guess what? Word has a perfectly good counter built into it.

No, I am not talking about mail merge, but rather Visual Basic for Applications.

Going off memory the process is to:-

  1. draft a model exhibit note certificate, with the date filled and my details filled in
  2. use insert two Document Variables, “ExhibitNo” and “ExhibitNoDup” , where appropriate in the document
  3. check that the default printer is set correctly in the printer control panel; and
  4. use the Macros -> Visual Basic Editor write and run this little program:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub Produce_Many_Exhibit_Notes()
Dim intStart As Integer
Dim intEnd As Integer
Dim intTotal As Integer
Dim i As Integer

intStart = InputBox("Start Exhibit Note Number:", "by Christopher Speck 25 May 2010", 1)
intEnd = InputBox("Ending Exhibit Note Number:", "by Christopher Speck 25 May 2010", 83)

If intStart = 0 Then
   MsgBox "Start must be equal to or greater then one", vbExclamation
   Exit Sub
End If

If intEnd < intStart Then
   MsgBox "Ending number equal to or greater then start number", vbExclamation
   Exit Sub
End If

intTotal = intEnd - intStart + 1

If MsgBox("Continuing will print " & intTotal & " Exhibit Notes from " & vbCrLf & _
intStart & " to " & intEnd & " and print them to your default" & vbCrLf & _
" printer. Are you sure you wish to  continue?", vbQuestion + vbYesNo) = vbYes Then
   For i = intStart To intEnd
      'increment document variables ExhibitNo and ExhibitNo_Dup
     ThisDocument.Variables("ExhibitNo").Value = i
      ThisDocument.Variables("ExhibitNo_Dup").Value = i
      ThisDocument.Fields.Update
      DoEvents
      ThisDocument.PrintOut
      DoEvents

      'for debugging purposes only
     'If MsgBox("Continue?", vbQuestion + vbYesNo) = vbNo Then
     '    Exit For
     'End If
  Next i
   MsgBox "Process complete", vbInformation
End If
End Sub

I wrote that program above. All up this process to me about 25 minutes to produce and print the 83 Exhibit Notes…a lot better then trying to use mail merge or manually incrementing each sheet, printing, and doing the same again.

Leave a Reply

*

Contact Nixz Kerr