Préambule

Une question récurrente sur les forums Excel, Access et Word est l’incrémentation de numéro en vue de gérer des documents (factures, notes d’envois, offres, courriers etc.).
Comme d’autres, je me suis penché sur ce problème et il y a des années, j’ai développé une fonction me permettant d’incrémenter un numéro et ce en fonction de plusieurs critères qui me semble fondamentaux dans une numérotation.
Ces critères sont bien sûr en premier lieu le dernier numéro utilisé, la périodicité pour la réinitialisation du compteur (en effet si la plupart du temps cette réinitialisation se fait chaque année, pour certains documents il arrive que la remise à 1 se fasse chaque mois ou pourquoi pas à d’autres période ou encore que la numérotation soit continue), ensuite la date de la dernière utilisation de ce numéro.
J’ai donc développé cette fonction en pensant à ces différents paramètres et tout dernièrement j’ai ajouté un dernier argument qui permet d’introduire une date de travail qui pourrait être différente de la date du jour.

But

La fonction renvoie un numéro qui est celui à placer dans le document.
Il est le résultat de l’incrémentation de 1 par rapport à l’argument LastCount ou bien 1 si la date du jour le paramètre LastDate PeriodOfChange

Arguments de la fonction

Quatre arguments dont seul le premier est obligatoire (pour une numérotation continue).

LastCount Dernier numéro utilisé
[LastDate] Dernière date d’incrémentation
[PeriodOfChange] Périodicité pour la réinitialisation du numéro. L’argument est de type string et peut avoir comme valeur (Y) pour annuel, (Q) pour trimestriel, (M) mensuel, (W) hebdomadaire, (D) journalière.
[WorkDay] Date de travail

 

Code de la fonction

Function Counter(LastCount As Long, _
Optional LastDate As Date, _
Optional PeriodOfChange As String = "C", _
Optional WorkDate As Date) As Long
' Author : Philippe Tulliez http://philippe.tulliez.be/
' Date : 2013-12-18 (first version 2002-05-28)
' Version: 3.1
' Fonction renvoyant un nombre entier en fonction des arguments suivant :
' ... Arguments ... (tous facultatifs sauf le 1er)
' LastCount (Long) ' Dernier numéro
' [LastDate] (Date) ' Dernière date d'incrémentation du compteur. (Défaut->Date du jour)
' [PeriodOfChange] (String) ' Périodicité de reinitialisation du compteur. (Continu par défaut)
' (Y) Annuel, (Q) Trimestriel, (M) Mensuel, (W) Hebdomadaire, (D) Jour
' [WorkDate] (Date) ' Date de travail. (Date du jour par défaut)

Dim Period As String
' Check Arguments
If LastDate = 0 And Len(PeriodOfChange) = 0 Then Counter = LastCount + 1: Exit Function
If LastDate = 0 Then LastDate = Date
If WorkDate = 0 Then WorkDate = Date
' Gestion des périodicités (Y)ear, (Q)uarter, (M)onth, (W)eek,(D)ay
Period = LCase(Left(PeriodOfChange, 1))
If InStr("yqmwd", Period) = 0 Then Period = "c"
Select Case Period
Case "y": Period = "yyyy"
Case "w": Period = "ww"
End Select
Select Case Period
Case "c": Counter = LastCount + 1
Case Else: Counter = 1 + LastCount * Abs(DateDiff(Period, LastDate, WorkDate, vbMonday) = 0)
End Select
End Function

Fichier exemple à télécharger