Numbering documents for invoices, order forms etc.

The first method below is based on code developed by fellow MVP Doug Robbins reproduced in a web page he developed for the MVP FAQ site. The number sequence is stored in an editable text file called Settings.ini which is stored here in the Word startup folder.

For a multi-user system any folder to which all users have read/write access can be used. Instead of using the Options.DefaultFilePath() you can enter the full path to the file.

Sub AddNoFromINIFile()
Dim SettingsFile As String
Dim Order As String
Dim sView As String
'Save ini file in the Word startup folder.
SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
'or, by using the following line, the Workgroup folder
'SettingsFile = Options.DefaultFilePath(wdWorkgroupTemplatesPath) & "\Settings.ini"

Order = System.PrivateProfileString(SettingsFile, _
"InvoiceNumber", "Order")

'If there is no InvoiceNumber reference in the ini file

'Create one and set the number to 1, otherwise increment the number
If Order = "" Then
    Order = 1
Else
    Order = Order + 1
End If

System.PrivateProfileString(SettingsFile, "InvoiceNumber", _
"Order") = Order
sView = ActiveWindow.View 'store the current view
With ActiveWindow
    .View = wdPrintView 'set the document view to print layout
    .ActivePane.View.SeekView = wdSeekCurrentPageHeader
    With Selection
        .WholeStory 'select any existing header text
        .Delete Unit:=wdCharacter, Count:=1 'and delete it
        .Font.Name = "Arial" 'Set the font characteristics
        .Font.Bold = True 'of the inserted header
        .Font.Italic = False 'if required
        .Font.Size = "10"
        .ParagraphFormat.Alignment = wdAlignParagraphRight

Note:

In the following example, I have expanded the numbering function to provide a complete working invoice template in order to explore the techniques used.

The macro module employs a number stored in the registry at:

HKEY_CURRENT_USER\Software\Microsoft\Office\Word\Settings\

in three sub keys

InvoiceNo
InvoiceLeadingText
InvoiceTrailingText

If the keys don't exist, the macros create them.

The macros in the follow section are intended for use on a stand-alone PC with a single user. For a single PC with multi-users who wish to access the same numbering sequence, then change the line

Const RegKey =

from

HKEY_CURRENT_USER\Software\Microsoft\Office\Word\Settings\

to

HKEY_LOCAL_MACHINE\Software\Microsoft\Office\Word\Settings\

However those users would have to have write access to the registry from their user accounts.

The macros provide a five digit format and the means to set or reset the start number. The macro also provides the opportunity to add leading and trailing text to the number which it places at a bookmark in the document. Any text that exists in the bookmark is removed. The setup routine allows the user to place the bookmark anywhere in the document.

I have annotated the macros so users can see both how they work and to enable changes to be made for personal requirements.

You can either add the code below to your own document template (not normal.dot) or download and modify the template linked at the end of this page to your own requirements.

Although setup to provide an invoice numbering function, with a few minor changes the macros could equally provide any type of document numbering. Merely ensure that the registry sub key names are unique to the application in hand.

Option Explicit
Dim WSHShell As Object
Dim oBMs As Bookmarks
Dim iCount As Long
Dim rkeyWord1 As String
Dim rkeyWord2 As String
Dim rkeyWord3 As String
Dim sCount As String
Dim sLeadingText As String
Dim sTrailingText As String
Dim Response As String
Dim myRng As Range
Dim i As Long
Const RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\Word\Settings\"
 

Sub InvoicerSetup()
'Macro by Graham Mayor 6 February 2006
'With input and improvements suggested by Greg Maxey
'http://gregmaxey.mvps.org/
'Revision 17
InvoicerStart:
Set WSHShell = CreateObject("WScript.Shell")
Set oBMs = ActiveDocument.Bookmarks
On Error GoTo setUpError:
 

If MsgBox("Locate/relocate the Invoice number" _
& " at the current cursor position?", _
vbYesNo, "Invoice Number Position") = vbYes Then
    'It already exists so delete it
     If oBMs.Exists("SeqNum") Then
         oBMs("SeqNum").Range.Delete
     End If
'Define and setup empty bookmark
  Selection.Collapse wdCollapseStart
  Selection.Bookmarks.Add "SeqNum", Selection.Range
Else
'Force setup of bookmark
     If Not oBMs.Exists("SeqNum") Then
         MsgBox "Place the insertion point where you want the" _
         & " invoice number and start this procedure again.", vbOKOnly, _

         "Insertion Point"
         Exit Sub
     End If
End If
'Setup/Reset the three starting entries in the registry
rkeyWord1 = WSHShell.RegRead(RegKey & "InvoiceNo")
rkeyWord2 = WSHShell.RegRead(RegKey & "InvoiceLeadingText")
rkeyWord3 = WSHShell.RegRead(RegKey & "InvoiceTrailingText")

'ask for the new start number, whilst showing the current next number as default

iCount = InputBox("Set/reset starting sequence number? The" _
& " next number is currently: " & Val(rkeyWord1), _
"Sequence Number", Val(rkeyWord1))

If iCount <= 1 Then 'if negative start number or zero is entered
     iCount = 1 ' make it 1!
End If

'Write the start number to the registry
WSHShell.regwrite RegKey & "InvoiceNo", iCount

'Ask for the leading text, whilst showing the existing leading text as default
sLeadingText = InputBox("Add leading text?", "Leading Text", rkeyWord2)
'Write the chosen leading text to the registry
WSHShell.regwrite RegKey & "InvoiceLeadingText", sLeadingText
'Ask for the trailing text, whilst showing the existing trailing text as default
sTrailingText = InputBox("Add trailing text?", "Trailing Text", rkeyWord3)
'Write the chosen trailing text to the registry
WSHShell.regwrite RegKey & "InvoiceTrailingText", sTrailingText

'Setup done - Ensure user has a reminder to save the template

If MsgBox("Now click 'OK' to save and close the template" & vbCr & _
"to make the changes available to the documents" & vbCr & _
"or 'Cancel' and re-run setup", vbOKCancel) = vbOK Then
     With ActiveDocument
         .Save
         .Close
     End With
End If
Exit Sub

setUpError:
'If rKeyWord1 is empty then assign default values
If rkeyWord1 = "" Then
     WSHShell.regwrite RegKey & "InvoiceNo", 1
     WSHShell.regwrite RegKey & "InvoiceLeadingText", "Invoice No:"
     WSHShell.regwrite RegKey & "InvoiceTrailingText", ""
     iCount = 1

'and tell the user what's happening
     MsgBox "The registry entries have not yet been created." _
     & vbCr & "Default entries will be applied." & vbCr & vbCr & _
     "These can be changed and the start number reset" _
     & vbCr & "from the Invoice Setup toolbar button." _
     & vbCr & vbCr & "To access that, close this document without saving" _
     & vbCr & "and open the Invoice.dot template.", _
     vbOKOnly, "Default Entries"
     Resume
End If
End Sub
 

Sub AddSeqNumFromRegistry()
Dim BMRange As Range
Set WSHShell = CreateObject("WScript.Shell")
Set oBMs = ActiveDocument.Bookmarks

'Read the registry entries
iCount = Val(WSHShell.RegRead(RegKey & "InvoiceNo"))
sLeadingText = WSHShell.RegRead(RegKey & "InvoiceLeadingText")
sTrailingText = WSHShell.RegRead(RegKey & "InvoiceTrailingText")
sCount = Format(iCount, "00000") 'Set the number format to 5 digits
If sTrailingText <> "" Then

    'If there is trailing text space it from the number
     sTrailingText = " " & sTrailingText
End If
'Identify current Bookmark range and insert text
On Error GoTo AddNoError:
Set BMRange = oBMs("SeqNum").Range
BMRange.Text = sLeadingText & " " & sCount _
& sTrailingText 'Re-insert the bookmark
oBMs.Add "SeqNum", BMRange
ActiveDocument.Fields.Update
'Increment the number in the registry

WSHShell.regwrite RegKey & "InvoiceNo", iCount + 1
Exit Sub
AddNoError:
If Err.Number = 5941 Then 'Bookmark is missing
     MsgBox "The bookmark has been deleted. You must run" _
     & " the Setup routine to redefine the number position.", _
     vbOKOnly, "Missing Bookmark!"
     Exit Sub
End If
End Sub
 

Sub AutoNew()
On Error GoTo AutoNewError: 'No registry entries :(
'Turn off the toolbar as this is only used when editing the template

With CommandBars("Invoice Tools")
    .Controls("Invoice Setup").Visible = False
    .Controls("Insert Next Number").Visible = False
    .Controls("Inactive").Visible = True
    .Visible = False
End With
ActiveDocument.AttachedTemplate.Save
AddSeqNumFromRegistry
Exit Sub

AutoNewError:
'Pop up a message to let the user know what's happening
MsgBox "The registry entries have not yet been created." _
& vbCr & "Default entries will be applied." & vbCr & vbCr & _
"These can be changed and the start number reset" _
& vbCr & "from the Invoice Setup toolbar button." _
& vbCr & vbCr & "To access that, close this document without saving" _
& vbCr & "and open the Invoice.dot template.", _
vbOKOnly, "Default Entries"

'Write default entries to registry
WSHShell.regwrite RegKey & "InvoiceNo", 1
WSHShell.regwrite RegKey & "InvoiceLeadingText", "Invoice No:"
WSHShell.regwrite RegKey & "InvoiceTrailingText", ""
Resume 'and re-run the macro
End Sub

Sub NoAction() 'User has tried to operate the macros from a document
MsgBox "The Invoice Tools are only available in the open template." & vbCr & vbCr & _
"If this message shows and you already have the template open, close it" & vbCr & _
"and then re-open it again", vbOKOnly, "Invoice Tools"
End Sub
 

If you don't know what to do with macro listings see - Installing Macros From Listings