VBA / Fonction - Incrémentation de n°

[Philippe Tulliez]

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.

[gilt83]

Bonsoir corona,le forum

Je viens de decouvrir ce post et je vous demande si vous avez le classeur exemple.
Merci de votre reponse et bonne soirée

[Philippe Tulliez]

Bonjour,
Voici le classeur illustrant l'utilisation de la fonction Counter.