VBA : Date de début d’une période

Publié le par

Je vous présente une fonction qui retourne, en fonction de la date passée en paramètre et la période choisie (Mois, Bimestre, Trimestre, Quadrimestre, Semestre ou Année), la première date de cette période.

La fonction

Public Function DateDebutPeriode(ByVal DateRef As Date, ByVal Periode As Integer) As Date
'Philben - v1.0 - Free to use
   Select Case Periode
   Case 1, 2, 3, 4, 6, 12
      DateDebutPeriode = DateSerial(Year(DateRef), Int((Month(DateRef) - 1) / Periode) * Periode + 1, 1)
   End Select
End Function

 
Paramètres
Le premier paramètre est la date de référence de la période, le deuxième indique le type de période : 1 pour mensuelle, 2 pour bimestrielle, 3 pour trimestrielle, 4 pour quadrimestrielle, 6 pour semestrielle et 12 pour annuelle.

Il y a donc dans une année, 12 périodes mensuelles, 6 bimestres, 4 trimestres, 3 quadrimestres, 2 semestres.

Exemples
Des exemples à exécuter dans fenêtre ‘Exécution’ (Ctrl+G) de l’éditeur VBA (Alt+F11).

?DateDebutPeriode(#2013/09/20#,1) 'Mois -> 01/09/2013

?DateDebutPeriode(#2013/08/20#,2) 'Bimestre -> 01/07/2013
?DateDebutPeriode(#2013/09/20#,2) 'Bimestre -> 01/09/2013

?DateDebutPeriode(#2013/09/20#,3) 'Trimestre -> 01/07/2013
?DateDebutPeriode(#2013/08/20#,4) 'Quadrimestre -> 01/05/2013
?DateDebutPeriode(#2013/09/20#,6) 'Semestre -> 01/07/2013
?DateDebutPeriode(#2013/09/20#,12) 'Annuelle -> 01/01/2013

 
Vérification
Cette fonction teste chaque période pour chaque mois d’une année choisie aléatoirement.
Un astérisque avant une date indique un changement de période.

Public Function TestDebutPeriode()
   Dim i As Integer, j As Integer, y As Integer, s As String, c As String, r As Date, d As Date
   Dim v As Variant, aDerDate(0 To 5) As Date, aCpt(0 To 5) As Integer, bErr As Boolean

   v = VBA.Array(1, 2, 3, 4, 6, 12)
   Randomize
   y = Int(3000 * Rnd) + 100

   Debug.Print "Année aléatoire : " & y
   Debug.Print "Mois" & vbTab & " Mensuel(1)" & vbTab & "Bimestre(2)" & vbTab & " Trimes.(3)" & vbTab & " Quadri.(4)" & vbTab & "Semestre(6)" & vbTab & " Année(12)"

   For i = 1 To 12
      r = DateSerial(y, i, Int(28 * Rnd) + 1)   '28 maxi pour février...
      s = Format(r, "mm  ") & vbTab
      For j = LBound(v) To UBound(v)
         d = DateDebutPeriode(r, v(j))
         If d <> aDerDate(j) Then
            c = "*"
            If Day(d) = 1 And Year(d) = y Then aCpt(j) = aCpt(j) + 1
         Else
            c = " "
         End If
         s = s & c & d & vbTab
         aDerDate(j) = d
      Next j
      Debug.Print s
   Next i

   For i = LBound(v) To UBound(v)
      If aCpt(i) <> 12 \ v(i) Then
         Debug.Print "Erreur détectée pour la période n°" & (i + 1)
         bErr = True
      End If
   Next i

    If Not bErr Then Debug.Print "Aucune erreur détectée..."
End Function

 
@+

Philippe

Laisser un commentaire