Fonction pour les dates.

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 045 fois - Téléchargée 45 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
15838
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
76 -
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
-
imagine que la méthode Format n'existe pas....
Plus simple oui... mais moins pédagogique !
cs_Warny
Messages postés
478
Date d'inscription
mercredi 7 août 2002
Statut
Membre
Dernière intervention
10 juin 2015
-
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.