Convertir une date républicaine en date grégorienne sur Excel

<< Retour Calendrier Républicain

Lorsque le généalogiste dépouille sur Excel des archives datant de la période révolutionnaire, il est confronté au calendrier républicain : la conversion de ces dates est longue et fastidieuse. Cette page présente comment créer une fonction Excel pour convertir les dates du calendrier républicain.

Etape 1 : Installation de l'onglet "Développeur" sur Excel

• Lorsque vous ouvrez Excel, si votre menu se présente sans l'outil "développeur", c'est-à-dire ainsi :

il est nécessaire de l'ajouter.

• Pour cela, vous allez dans "Fichier" :

• Puis dans "Options" :

• Une fenêtre s'ouvre. Il faut cliquer dans "Personnaliser le ruban" puis cocher "développeur".

• Une fois que "Développeur" est coché, cliquez "ok".
• L'onglet "Développeur" est désormais visible en haut dans le menu !

Etape 2 : Installation de la fonction dans le fichier Excel ouvert

• Cliquez sur "Développeur", allez ensuite dans "Visual Basic".
• Une fenêtre vierge s'ouvre. A gauche de l'écran, cliquez droit sur "VBA project(Classeur1)" - Il se peut que ce ne soit pas le même nom utilisé. Puis allez dans "insertion" puis sélectionnez "module".

• Sur la fenêtre qui s'affiche à droite, collez le code suivant :


Option Explicit

Function AnalyserDate(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(intJour, "00") & "/" & Format(intMois, "00") & "/" & Format(intAnnee, "0000")
 End If
 AnalyserDate = 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", UCase("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 DateRepublicaine(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
   DateRepublicaine = AnalyserDate(intAnneeR, intMoisR, intJourR)
 Else
  DateRepublicaine = 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 = " "
 ElseIf InStr(1, AChaineDate, ".") > 0 Then
   ChercherSeparateur = "."
 ElseIf InStr(1, AChaineDate, "_") > 0 Then
   ChercherSeparateur = "_"
 End If

End Function




• Une fois que le code est collé, il suffit de cliquer sur l'icône Excel en haut à gauche pour revenir à la présentation normale d'Excel. Vous pouvez taper une date républicaine dans une cellule (par exemple en B2). En C2, en écrivant =daterepublicaine(B2) vous aurez la date grégorienne qui s'affichera.

Etape 3 : Installation de la fonction Excel dans tous les fichiers Excel

• Une fois la fonction créée, il faut que la fonction soit présente à l'ouverture de n'importe quel fichier.
• Pour cela, "enregistrez sous" le fichier, donnez lui le titre "Calendrier républicain" et dans "Type", choisissez "Complément Excel" ou "Macros complémentaires".
• Une fois enregistré, ouvrez un document Excel, puis dans "Développeur", cliquez sur "Compléments Excel" et cochez "Calendrier républicain".

• La fonction est désormais installée !!