Public Function DateFinPeriode(ByVal DateRef As Date, ByVal Periode As Integer) As Date
   Select Case Periode
   Case 1, 2, 3, 4, 6, 12
      DateFinPeriode = DateSerial(Year(DateRef), Int((Month(DateRef) - 1) / Periode) * Periode + Periode + 1, 0)
   End Select
End Function

?DateFinPeriode(#2013/09/20#,1) 'Mois -> 30/09/2013
?DateFinPeriode(#2013/09/20#,2) 'Bimestre -> 31/10/2013
?DateFinPeriode(#2013/09/20#,3) 'Trimestre -> 30/09/2013
?DateFinPeriode(#2013/09/20#,4) 'Quadrimestre -> 31/12/2013
?DateFinPeriode(#2013/09/20#,6) 'Semestre -> 31/12/2013
?DateFinPeriode(#2013/09/20#,12) 'Annuelle -> 31/12/2013

Public Function TestFinPeriode()
   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
   
   'vba.Array retourne toujours un tableau de base zéro (indépendance vis à vis de Option Base) contrairement à Array()
  'Mais en règle générale, on utilise Array()
  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)"

   'affecte une date initiale non interférente
  For j = LBound(aDerDate) To UBound(aDerDate): aDerDate(j) = #5/15/2000#: Next j

   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 = DateFinPeriode(r, v(j))
         If d <> aDerDate(j) Then
            c = "*"
            If Month(d) <> Month(aDerDate(j)) 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