A COMPLÉTER PAR LES GENTILS MEMBRES ÉCLAIRÉS DU FORUM

"Ne pas se laisser en....er la vie par des problèmes de format de dates" est l'objet de cette discussion.

Dans le but de réunir le maximum de renseignements sur l'utilisation, la manipulation, la conversion, les calculs et la mise en forme des dates, j'ai commencé à placer ici quelques procédures offrant une solution à quelques-uns des nombreux problèmes de date rencontrés ici et là.


Divers formats de dates pour arriver au même résultat. Demo
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
Sub FormaterReformaterUneDateFormatee()
Dim LesDates, UneDate, i As Byte
LesDates = Array("16/02/2006", "02/16/07", "2008/2/16", "16 février 2009", "16-02-2010", "16-fév-2011")
For i = 0 To UBound(LesDates) 
    UneDate = CDbl(CDate(LesDates(i)))
    Cells(i + 1, 1).Value = "'" & LesDates(i) 'le vieux format
    Cells(i + 1, 2).Value = Format(UneDate, "dd mmmm yyyy") 'le nouveau
Next
 
'Le temps sous ses différentes  composantes
Dim LaDate As Date
Dim msg As String
    LaDate = Now        'ou toute autre date en format jj/mm/aa
    msg = "'= Format(CDbl(LaDate), " & """dd mmmm yyyy""" & ") & Time"
    Cells(i + 1, 1).Offset(1, 0).Value = msg
    Cells(i + 1, 1).Offset(1, 1).Value = Format(CDbl(LaDate), "dd mmmm yyyy") & " " & Time
    Cells(i + 1, 1).Offset(1, 2).Value = "Date et heure"
 
    msg = "'= Time"
    Cells(i + 1, 1).Offset(2, 0).Value = msg
    Cells(i + 1, 1).Offset(2, 1).Value = Time
    Cells(i + 1, 1).Offset(2, 2).Value = "Heure non formatée"
 
    msg = "'= Format(CDate(LaDate), " & """dddd dd mmm yyyy""" & ")"
    Cells(i + 1, 1).Offset(3, 0).Value = msg
    Cells(i + 1, 1).Offset(3, 1).Value = Format(CDate(LaDate), "dddd dd mmm yyyy")
    Cells(i + 1, 1).Offset(3, 2).Value = "Le jour et la date, un des nombreux formats"
 
    msg = "'= Format(CDate(LaDate), " & """dddd""" & ")"
    Cells(i + 1, 1).Offset(4, 0).Value = msg
    Cells(i + 1, 1).Offset(4, 1).Value = Format(CDate(LaDate), "dddd")
    Cells(i + 1, 1).Offset(4, 2).Value = "Le jour de la semaine"
 
    msg = "'= Weekday(Now, 2)"
    Cells(i + 1, 1).Offset(5, 0).Value = msg
    Cells(i + 1, 1).Offset(5, 1).Value = Weekday(Now, 2)
    Cells(i + 1, 1).Offset(5, 2).Value = "Numéro du jour de la semaine si le premier jour de la semaine est un lundi"
 
    msg = "'= Weekday(Now, 1)"
    Cells(i + 1, 1).Offset(6, 0).Value = msg
    Cells(i + 1, 1).Offset(6, 1).Value = Weekday(Now, 1)
    Cells(i + 1, 1).Offset(6, 2).Value = "Numéro du jour de la semaine si le premier jour est un dimanche"
 
    msg = "'= DateDiff(" & """d""" & ", " & """1/1/2007""" & ", Now)"
    Cells(i + 1, 1).Offset(7, 0).Value = msg
    Cells(i + 1, 1).Offset(7, 1).Value = DateDiff("d", "1/1/2007", Now)
    Cells(i + 1, 1).Offset(7, 2).Value = "Numéro du jour dans l'année"
 
    msg = "'= DatePart(" & """ww""" & ", " & """4/4/2009""" & ", 2, vbFirstFourDays)"
    Cells(i + 1, 1).Offset(8, 0).Value = msg
    Cells(i + 1, 1).Offset(8, 1).Value = DatePart("ww", "4/4/2009", 2, vbFirstFourDays)
    Cells(i + 1, 1).Offset(8, 2).Value = "Numéro de semaine si la semaine commence le lundi"
 
    msg = "'= DatePart(" & """ww""" & ", " & """4/4/2009""" & ", 1, vbFirstFourDays)"
    Cells(i + 1, 1).Offset(9, 0).Value = msg
    Cells(i + 1, 1).Offset(9, 1).Value = DatePart("ww", "4/4/2009", 1, vbFirstFourDays)
    Cells(i + 1, 1).Offset(9, 2).Value = "Numéro de semaine si la semaine commence le dimanche"
End Sub
Il est parfois intéressant de savoir que DateDiff arrondit les années. Démo :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Fonction_DateDiff()
Dim LesSecondes, LesSeconde As Double, dateref As Date, NbAnnées As Integer
Dim année As Double, mois As Double, Jour As Double
Dim DateDépart As Date, DateToday As Date
    dateref = "27/10/2000"
    NbAnnées = DateDiff("yyyy", dateref, Now)
 
    'Vérif
    'Syntaxe 1 pour convertir année, mois, jour en N° de série
    année = CDbl(Year(dateref))
    mois = CDbl(Month(dateref))
    Jour = CDbl(Day(dateref))
    'Vous avez réussi à séparer le jour du mois de l'année,
    'il reste juste à tout réunir, ce que propose DateSerial
    DateDépart = DateSerial(année, mois, Jour)
 
    'Et en beaucoup plus simple...
    DateDépart = CDbl(CDate(dateref))
 
    'Syntaxe 2
    année = Val(Format(Now, "yy"))
    mois = Val(Format(Now, "mm"))
    Jour = Val(Format(Now, "dd"))
    DateToday = DateSerial(année, mois, Jour)
    'Plus simple...
    DateToday = Now
 
    MsgBox "Date départ : " & DateDépart & vbTab & "Date arrivée : " & DateToday & _
    vbCr & vbCr & "DateDiff renvoie " & FormatNumber(NbAnnées, "000,00") & " ans" & _
    vbCr & "mais..." & vbCr & "une soustraction année - année donne " & _
    Format(DateToday - DateDépart, "yy") & " ans, " & _
    Format(DateToday - DateDépart, "mm") & " mois et " & _
    Format(DateToday - DateDépart, "dd") & " jours", vbOKOnly, "Test"
 
    'Syntaxe 3 La même chose
    DateToday = Now
    DateDépart = CDbl(CDate(dateref))
    MsgBox "La même chose mais plus simple " & vbCr & Format(DateToday - DateDépart, "yy") & " ans, " & _
    Format(DateToday - DateDépart, "mm") & " mois et " & _
    Format(DateToday - DateDépart, "dd") & " jours", vbOKOnly, "Test"
 
End Sub
Par défaut le 1er jour de la semaine est un dimanche. Démo
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
Sub LesJoursDansLordre()
Dim NoSemaine, i As Byte
    For i = 1 To 7
        MsgBox Format(i, "dddd")
    Next
End Sub
'Un calendrier des seuls jours ouvrés. Une feuille par mois
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub CalendrierJoursOuvrés()
Dim ok As Boolean, jf As Boolean, JoursFériés As Variant, k As Byte
Dim i As Integer, j As Integer, NoLigne As Integer, dateref As Date
    Application.DisplayAlerts = False
    'Suppression de toutes les feuilles du classeur sauf une
    ActiveWorkbook.Sheets.Add Before:=Worksheets(1)
    For i = ActiveWorkbook.Worksheets.Count - 1 To 1 Step -1
        Worksheets(i).Delete
    Next
    JoursFériés = Array("", "1 janvier 2007", "28 mars 2007", "1 mai 2007", "8 mai 2007", "17 mai 2007", "28 mai 2007", "14 juillet 2007", "15 août 2007", "1 novembre 2007", "11 novembre 2007", "25 décembre 2007")
    'On nomme la feuille qui reste (janvier)
    ActiveSheet.Name = Format(DateSerial(2007, 1, 1), "mmmm") 
    NoLigne = 2
    For i = 1 To 365
        dateref = DateSerial(2007, 1, i)
        'Création de la feuille du mois
        'La feuille de janvier existe, on l'exclut : C'est le 1er du mois, mois > janvier
        If Format(dateref, "dd") = "01" And Month(dateref) > 1 Then
            NoLigne = 2
            ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveWorkbook.ActiveSheet.Name = Format(dateref, "mmmm")
        End If
        jf = False 'Exclusion des jours fériés
        For k = 1 To UBound(JoursFériés)
            jf = jf Or InStr(Format(CDate(dateref), "dd mmmm yyyy"), JoursFériés(k)) <> 0
            If jf Then Exit For 'C'est un jour férié
        Next k
        If Format(Weekday(dateref), "dddd") <> "samedi" And _
            Format(Weekday(dateref), "dddd") <> "dimanche" And _
            Not jf Then
            ActiveSheet.Cells(NoLigne, 1).Formula = UCase(Left(Format(dateref, "dddd"), 1))
            ActiveSheet.Cells(NoLigne, 2).Formula = Format(dateref, "dd")
            NoLigne = NoLigne + 1
        End If
    Next
End Sub
....................................................A compléter.
DateAdd ?

Liens vers d'autres solutions sur les dates
Jours ouvrés : Connaître la date vraie en ajoutant des jours ouvrés à une date