Use the following code:


'proc for generating invoice numbers form excel. Requires a standard
excel book, not a template, that cannot be set to a shared workbook.
Also it needs a custom documentproperty "template" of type yesno.
'This setup will work with multiple users given the basic xl file is
accesible to all users.
Users should never open the original template as read only.

' procedure voor het automatisch genereren van een invoice nummer
vanuit excel
' Uitgangspunt is een gewoon excel bestand dat niet als template
gebruikt wordt en ook
' niet gedeeltd wordt. Anders kan
' het laatst gebruikte factuurnummer niet teruggeschreven worden naar
de "Template"
' en wordt de factuurtemplate niet beschermd tegen openen door meerdere
gebruikers
' Er moet een documenteigenschap "Template" aangemaakt worden die
aangeeft of het document een
' template is of een factuur.

Private Sub Workbook_Open()
Dim lngInvoiceNr As Long
Dim strName As String
Dim intPos As Integer


' Als bestand een template is, meteen foutmelding en sluiten
If Me.Path = "" Then
MsgBox "factuur geopend als template, gaarne openen als gewoon
bestand", vbCritical, "factuur"
Me.Saved = True
Me.Close
GoTo Exit_here
End If

On Error GoTo Error1

' als dit de template is dat een factuur creeren
If Me.CustomDocumentProperties("Template") Then

'factuurnummer ophogen
With Me.Worksheets(1).Range("M3")
.Value = .Value + 1
lngInvoiceNr = .Value
End With


' template met nieuw factuurnummer opslaan
Application.DisplayAlerts = False
Me.Save
' opgeslagen, dus dit bestand is nou geen template meer
Me.CustomDocumentProperties("Template") = False
Application.DisplayAlerts = True

' bestandsnaam factuurnummer aanmaken
strName = Me.Name
intPos = InStrRev(strName, ".")
If intPos 0 Then strName = Left$(strName, intPos - 1)

' aangeven dat factuur nog niet is opgeslagen
Me.Saved = False

' gebruiker vragen om factuur op te slaan
While Not Me.Saved
Application.Dialogs(xlDialogSaveAs).Show strName &
CStr(lngInvoiceNr)
Wend



End If
Exit_he
' exit code kan hier

Exit Sub
Error1:

MsgBox Err.Description
GoTo Exit_here
End Sub


DM Unseen