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
| 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 |
Partager