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
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.