'//Code to be placed in a standard module
 
Option Explicit 
 
Sub SetNo() 
     
     'Ament to suit file name and location
    Const Invoice = "C:\DataFile.txt" 
     
    Const ForReading = 1, ForWriting = 2, ForAppending = 3 
    Dim fs, f, msg 
     
    Set fs = CreateObject("Scripting.FileSystemObject") 
     
     'Read the last entry from the datafile
    Set f = fs.openTextFile(Invoice, ForReading, TristateFalse) 
    Range("InvNo").Formula = f.readline 
    f.Close 
     
     'Increment the number in the data file
    Set f = fs.openTextFile(Invoice, ForWriting, TristateFalse) 
    f.write Range("InvNo").Formula + 1 
    f.Close 
     
End Sub 
 
 
Sub DoPrint() 
    Application.EnableEvents = False 
    If Range("InvNo") = "" Then SetNo 
    On Error GoTo Finish 
    ActiveWindow.SelectedSheets.PrintOut Copies:=InputBox("Print copies", "Print Invoice", 1) 
    Range("InvNo").ClearContents 
Finish: 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 
End Sub 
 
 
Sub GetNumber() 
    Application.EnableEvents = False 
    If Range("InvNo") = "" Then SetNo 
    Application.EnableEvents = True 
End Sub 
 
 '//Code to be placed in a Worksheet module
 
Option Explicit 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim Check As Long, NewCel As Range 
    Set NewCel = ActiveCell 
    Application.EnableEvents = False 
    If Not Intersect(Target, Range("InvNo")) Is Nothing Then 
        Check = MsgBox("Have you a reason to edit this box?", 292, "Edit Invoice Number") 
        If Check = vbNo Then Application.Undo 
    End If 
    NewCel.Select 
    Application.EnableEvents = True 
End Sub