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