VBA / Fonction - Incrémentation de n°
Bonjour,
Une question récurrente sur les forums Excel et Word est l'incrémentation de numéro en vue de gérer des documents (factures, note d'envoi, courrier 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é, ensuite la date de la dernière utilisation de ce numéro, en effet, si la plupart du temps une remise à zéro du compteur se fait chaque année, pour certains documents il arrive que la remise à zéro se fasse chaque mois ou pourquoi pas à d'autres période.
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.
Je mets donc à disposition de la collectivité cette petite fonction qui fera peut-être des heureux. C'est ce que je souhaite.
Code:
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
| Function Counter(LastCount, Optional LastDate As Date, Optional PeriodOfChange As String, Optional WorkDay As Date) As Long
' Author : Philippe Tulliez
' Date : 2002-05-28
' Fonction renvoyant un n° incrémenté en fonction des arguments suivants :
' LastCount ' Ancien n°
' ... Arguments Facultatifs ...
' [LastDate] ' Dernière date d'incrémentation du compteur. (Défaut->Date du jour)
' [PeriodOfChange] ' Périodicité de remise à zéro compteur. (Continu par défaut)
' [WorkDate] ' Date de travail. (Date du jour par défaut)
' Update
' v 2.1 - 2011-02-07
Dim wFlag As Boolean ' Si vrai RAZ(1) du compteur
' Check Arguments
If LastDate = 0 And Len(PeriodOfChange) Then PeriodOfChange = "C"
If LastDate = 0 Then LastDate = Date
If IsMissing(PeriodOfChange) Then PeriodOfChange = "yyyy"
If WorkDay = 0 Then WorkDay = Date
' Calcul différence entre LastDate & WorkDay
Select Case UCase(Left(PeriodOfChange, 1))
Case "Y" ' Périodicité Annuelle
wFlag = DateDiff("yyyy", LastDate, WorkDay) <> 0
Case "Q" ' Périodicité trimestrielle
wFlag = DateDiff("q", LastDate, WorkDay) <> 0
Case "M" ' Périodicité Mensuelle
wFlag = DateDiff("m", LastDate, WorkDay) <> 0
Case "W" ' Périodicité Mensuelle
wFlag = DateDiff("ww", LastDate, WorkDay, vbMonday) <> 0
Case "D" ' Périodicité Journalière
wFlag = DateDiff("d", LastDate, WorkDay) <> 0
End Select
' Incrémentation ou RAZ(1) du compteur
If wFlag Then Counter = 1 Else Counter = LastCount + 1
End Function |
Les questions, remarques et suggestions éventuelles sont bien sûr les bienvenues.
Très prochainement j'y ajouterai un classeur exemple.