Convertir dates républicaine (vba)

Commenter

Contenu du snippet

J'avais besoin de convertir des dates républicaines dans Excel. Et je n'ai trouvé sur les forum que du Java, du Delphi ou de l'OpenBasic. Alors j'en ai fait une adaptation en VBA (j'ai utilisé le source OpenBaisc et je l'ai mis à ma sauce). Si ça peu rendre service ...

Source / Exemple : 


Option Explicit

Function DateRepublicaine(AAnneeR As Integer, AMoisR As Integer, AJourR As Integer) As String
  Dim strDateG As String
  Dim intAnnee As Integer, intMois As Integer, intJour As Integer
  Dim lngJourBasic As Long
  Const JourBasicOffset = -39545 'Valeur magique calculée pour faire correspondre 1er vendémiaire an I et 22/9/1792
  Const JoursPar4ans = 1461
  Const JoursParMois = 30
  ' Vérifications au départ :  On n'accepte que les années entre 1 et 14.
  '  Selon Wikipedia, il n'y aurait pas consensus sur la détermination (virtuelle) des années "sextiles"
  '  (avec 6 jours complémentaires) si le calendrier avait été utilisé au delà de l'an 14.
  If (AAnneeR < 1) Or (AAnneeR > 14) Then
    strDateG = "Date hors champ de conversion"
  ElseIf (AMoisR < 1) Or (AMoisR > 13) Then
  ' On notera que les jours complémentaires sont affectés à un mois fictif. Pas de vérif des années "sextiles"
  ElseIf (AJourR < 1) Or (AJourR > 30) Or ((AJourR > 6) And (13 = AMoisR)) Then
  Else
   ' A partir d'ici, j'applique la formule magique de Monsieur Scott E Lee
    lngJourBasic = Int((AAnneeR * JoursPar4ans) / 4) + (AMoisR - 1) * JoursParMois + AJourR + JourBasicOffset
    intAnnee = Year(lngJourBasic)
    intMois = Month(lngJourBasic)
    intJour = Day(lngJourBasic)
    strDateG = Format(intAnnee, "0000") & "-" & Format(intMois, "00") & "-" & Format(intJour, "00")
  End If
  DateRepublicaine = strDateG
End Function

Private Function NumeroMois(ByVal ANomMoisR As String, ByRef ARepublicain As Boolean) As Integer
  Dim intRangMoisR As Integer
  Dim strNomMoisR  As String
  Select Case UCase(Left$(Trim(ANomMoisR), 4))
    Case "VEND", "VD", "JANV", "JAN", "JANU"
      intRangMoisR = 1
    Case "BRUM", "BR", "FEV", "FEB", "FEVR", UCase("FéVR"), "FEBR"
       intRangMoisR = 2
    Case "FRIM", "FRI", "MARS", "MAR", "MARC", "MA"
        intRangMoisR = 3
    Case "NIVO", "NIV", "NI", "AVRI", "AVR", "APR", "APRI"
       intRangMoisR = 4
    Case "PLUV", "PLU", "PL", "MAI", "MAY"
        intRangMoisR = 5
    Case "VENT", "VEN", "VE", "JUIN", "JUN", "JUNE"
       intRangMoisR = 6
    Case "GERM", "GE", "JUIL", "JULY", "JUL"
        intRangMoisR = 7
    Case "FLOR", "FLO", "FL", "AOUT", "AOU", "AUG", "AOÛT"
       intRangMoisR = 8
    Case "PRAI", "PRA", "PR", "SEPT", "SEP"
      intRangMoisR = 9
    Case "MESS", "MES", "ME", "OCTO", "OCT"
       intRangMoisR = 10
    Case "THER", "THE", "TH", "NOV", "NOVE"
        intRangMoisR = 11
    Case "FRUC", "FRU", "FR", "DEC", "DECE", UCase("DéCE")
       intRangMoisR = 12
    Case "COMP", "CO"
       intRangMoisR = 13
    Case Else
       intRangMoisR = 0
  End Select
  Select Case UCase(Left$(Trim(ANomMoisR), 1))
    Case "V", "B", "G", "P", "T", "C"
      ARepublicain = True
    Case Else
      Select Case UCase(Left$(Trim(ANomMoisR), 2))
      Case "NI", "ME", "FR", "FL"
        ARepublicain = True
      Case Else
        ARepublicain = False
      End Select
  End Select
  NumeroMois = intRangMoisR
End Function

Public Function AnalyserDate(AChaineDate As String) As String
  Dim strSeparateur  As String
  Dim varContenuDate As Variant
  Dim intContenu     As Integer
  Dim intMoisR       As Integer
  Dim intJourR       As Integer
  Dim intAnneeR      As Integer
  Dim blnRepublicain As Boolean
  Dim strMois        As String
  'Quel est le séparateur
  strSeparateur = ChercherSeparateur(AChaineDate)
  'Découper la date en éléments séparés
  varContenuDate = Split(AChaineDate, strSeparateur, -1)
  'Combien d'éléments ?
  intContenu = UBound(varContenuDate)
  If intContenu = 2 Then
    If IsNumeric(varContenuDate(1)) Then
      intMoisR = CInt(varContenuDate(1))
    Else
      intMoisR = NumeroMois(CStr(varContenuDate(1)), blnRepublicain)
    End If
  End If
  If IsNumeric(varContenuDate(0)) Then intJourR = CInt(varContenuDate(0))
  If IsNumeric(varContenuDate(2)) Then intAnneeR = CInt(varContenuDate(2))
  If blnRepublicain Then
    AnalyserDate = DateRepublicaine(intAnneeR, intMoisR, intJourR)
  Else
    AnalyserDate = Format(intAnneeR, "0000") & "-" & Format(intMoisR, "00") & "-" & Format(intJourR, "00")
  End If
End Function

Private Function ChercherSeparateur(AChaineDate As String) As String
  If InStr(1, AChaineDate, "/") > 0 Then
    ChercherSeparateur = "/"
  ElseIf InStr(1, AChaineDate, "-") > 0 Then
    ChercherSeparateur = "-"
  ElseIf InStr(1, AChaineDate, " ") > 0 Then
    ChercherSeparateur = " "
  End If
End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (laurentmayolle)