Fonction pour les dates.

0/5 (3 avis)

Snippet vu 4 288 fois - Téléchargée 48 fois

Contenu du snippet

quelque algos en attendant noèl...

Source / Exemple :


Dim  Dayname(6) As string           'à completer...
Dim  MonthName(11) As string      'à completer. ..

Function DayOfWeek(y1 As Long, _
                    m1 As Integer, _
                    d1 As Integer) As Integer
    Dim lm As Integer
    Dim ly As Integer
    Dim iResult As Integer
    
    lm = m1: ly = y1

    If lm < 3 Then
      ly = ly - 1
      lm = lm + 12
    End If

    iResult = (d1 + (153 * lm - 457) \ 5 + _
                    Int(365.25 * ly) - Int(ly * 0.01) + _
                    Int(ly * 0.0025) + 2) Mod 7

    DayOfWeek = IIf(iResult < 0, _
                iResult = iResult + 7, iResult)

End Function

Function IsAnneeBissextile(intYear As Integer) As Integer
     IsAnneeBissextile = ((intYear Mod 4 = 0) And _
    (intYear Mod 100 <> 0)) Or (intYear Mod 400 = 0)
End Function

Function GetNbDaysInMonth(intMonth As Integer, _
            intYear As Integer) As Integer
    Select Case intMonth
        Case 2: GetNbDaysInMonth = _
        IIf(IsAnneeBissextile(intYear) = -1, 29, 28)
        Case 4, 6, 9, 11: GetNbDaysInMonth = 30
        Case Else: GetNbDaysInMonth = 31
    End Select
End Function

Function IsDateValid(stringDate As String) As Integer
     Dim intDay As Integer
     Dim intMonth As Integer
     Dim intYear As Integer

    If Len(stringDate) <> 10 Then
        IsDateValid = False: Exit Function
    End If
    
    intDay = Val(Mid$(stringDate, 1, 2))
    intMonth = Val(Mid$(stringDate, 4, 2))
    intYear = Val(Right$(stringDate, 4))

    If intMonth > 31 Then
        IsDateValid = False: Exit Function
    End If

    If intDay > GetNbDaysInMonth(intMonth, intYear) Then
        IsDateValid = False: Exit Function
    End If

    IsDateValid = True

End Function

Function GetLongDate(dtDate As String, _
                blnRealLong As Integer) As String
    Dim intDay As Integer
    Dim intMonth As Integer
    Dim intYear As Integer
    Dim iFirstDay As Integer
    
    intDay = Val(Mid$(dtDate, 1, 2))
    intMonth = Val(Mid$(dtDate, 4, 2))
    intYear = Val(Right$(dtDate, 4))

    iFirstDay = DayOfWeek(intYear, intMonth, intDay)
    If blnRealLong Then
        GetLongDate = DayName(iFirstDay) & " " & CStr(intDay) & _
        " " & MonthName(intMonth - 1) & " " & CStr(intYear)
    Else
        GetLongDate = MonthName(intMonth - 1) & " " & CStr(intYear)
    End If
End Function

Conclusion :


aucun bug connu !!

A voir également

Ajouter un commentaire Commentaires
cs_DARKSIDIOUS Messages postés 15814 Date d'inscription jeudi 8 août 2002 Statut Membre Dernière intervention 4 mars 2013 130
11 oct. 2002 à 17:19
Non moi je trouve que c'est une bonne source pour ce qui ne connaissent pas déjà ces fonctions. Bravo, ca vaut au moins 9/10.

DARK SIDIOUS
AquelEPOC Messages postés 1 Date d'inscription vendredi 11 octobre 2002 Statut Membre Dernière intervention 11 octobre 2002
11 oct. 2002 à 15:02
imagine que la méthode Format n'existe pas....
Plus simple oui... mais moins pédagogique !
cs_Warny Messages postés 473 Date d'inscription mercredi 7 août 2002 Statut Membre Dernière intervention 10 juin 2015
11 oct. 2002 à 12:29
Plus Simple
GetlongDate(Date) = Format (Date, "DDDD DD MMMM YYYY")
Day of week existe
NbJourDuMois peut être trouvé en retrachant le premier jour du mois suivant au premier jour du mois (addDate ou décomposition)

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.