FAQ Visual Basic
FAQ Visual Basic Consultez toutes les FAQ
Nombre d'auteurs : 50, nombre de questions : 300, dernière mise à jour : 15 juin 2021
Sommaire→Divers bis→Manipulation de dates- Comment obtenir une date à partir des numéros du jour, de la semaine et de l'année ?
- Comment déterminer le premier jour d'une semaine ?
- Comment convertir une chaîne de caractères en date ?
- Comment ajouter des heures, des jours ou des mois à une date ?
- Comment calculer le temps écoulé entre deux dates ?
- Comment convertir une date julienne ?
- Comment connaître le dernier jour du mois ?
- Comment trier ou comparer des dates facilement ?
- Comment savoir si une année est bisextile ?
- Comment créer un timer sans utiliser le composant standard de VB6 ?
Public Function InvDatePart(ByVal PosJour As Integer, ByVal NumSemaine As Integer, ByVal Annee As Integer) As Date
Dim tmpDate As Date
tmpDate = CDate("1/1/" & Format$(Annee))
If Weekday(tmpDate, vbMonday) < 6 Then NumSemaine = NumSemaine - 1
tmpDate = DateAdd("ww", NumSemaine, tmpDate)
tmpDate = DateAdd("d", PosJour - Weekday(tmpDate, vbMonday), tmpDate)
InvDatePart = tmpDate
End FunctionPar exemple, InvDatePart(3, 10, 2004) vous renvoie la date correspondant au troisième jour de la dixième semaine de l'année 2004.
NOTE : Ce code considère que la semaine n°1 est celle qui contient au moins quatre jours dans la nouvelle année.
Public Function PremierJourSemaine(ByVal numSemaine As Byte, ByVal annee As Integer) As Date
Dim d As Date
Dim numS As Integer
' premier jour de l'année
d = DateSerial(annee, 1, 1)
' numéro de la semaine du 1er janvier
numS = DatePart("ww", d, vbMonday, vbFirstFourDays)
' si le 1er janvier fait partie de la dernière semaine de l'année précédente
' alors passe à la semaine suivante (la première de la nouvelle année)
If numS <> 1 Then d = DateAdd("d", 7, d)
' calcule le premier jour de la première semaine de l'année
d = DateAdd("d", 1 - Weekday(d, vbMonday), d)
' ajoute (numSemaine-1) semaines
PremierJourSemaine = DateAdd("ww", numSemaine - 1, d)
End FunctionPour convertir une expression en date, vous pouvez utiliser la fonction CDate(expression). Si l'expression à convertir n'est pas une date correcte d'après le format indiqué dans les paramètres régionaux de Windows, CDate essaie d'utiliser un autre format. Si la fonction ne réussit pas à faire la conversion, elle génère une erreur de type "Type Mismatch". Dans l'exemple ci-dessous, une date est demandée à l'utilisateur. Sa réponse est alors convertie en date.
Dim Rep As String, DateDeNaissance As Date
Do
Rep = InputBox("Quelle est votre date de naissance ?")
Loop While (Not IsDate(Rep))
DateDeNaissance = CDate(Rep)Vous pouvez utiliser la fonction DateAdd (intervalle, nombre, date)
intervalle : chaîne de caractères indiquant
l'intervalle de temps que vous voulez ajouter ("m" : mois, "d" : jour, "yyyy" : année, etc...)
nombre : nombre d'intervalles que vous voulez ajouter
valeur renvoyée : une date contenant le résultat (la date passée en argument n'est pas modifiée)
Quelques exemples :
today = Now()
DateAdd("m", 3, today) 'renvoie today + 3 mois
DateAdd("d", 2, today) 'renvoie today + 2 jours
DateAdd("ww", 1, today) 'renvoie today + 1 semaine
DateAdd("h", 1, today) 'renvoie today + 1 heureAvec la fonction DateDiff() :
Dim date1 As Date, date2 As Date
date1 = "01/01/2004"
date2 = "01/01/2005"
MsgBox "Durée en jours : " & DateDiff("d", date1, date2)
MsgBox "Durée en nombre de mois : " & DateDiff("m", date1, date2)Dim DateJulienne As String
Dim Reponse As Date
DateJulienne = "2002211"
Reponse = DateSerial(CInt(Left(JulianVal, 4)), 1, CInt(Mid(JulianVal, 5)))
' La valeur renvoyée est une date
MsgBox ReponseIl suffit de passer au mois suivant et de retirer 1 jour. Le code suivant se base sur le mois en cours.
Dim Reponse As Date
Reponse = CDate("01/" & Month(Date) + 1 & "/" & Year(Date))
Reponse = DateAdd("d", -1, Reponse)
MsgBox ReponseExtrait de l'aide Microsoft Visual Basic :
Les dates sont stockées sous la forme d'une partie d'un nombre réel.
Les valeurs situées à gauche du séparateur décimal représentent la date, tandis que celles situées à sa droite représentent l'heure. Les valeurs négatives correspondent à des dates antérieures au 30 décembre 1899.
L'astuce consiste donc à transformer les dates en valeurs décimales, avant de les comparer ou de les trier !
Exemple :
If CDec(CDate(MaDate1)) >= CDec(CDate(MaDate2)) And CDec(CDate(MaDate3)) < CDec(CDate(Now)) Then
Un autre exemple de Tri d'une ListView sur une colonne Date par SilkyRoad
2 solutions vous sont proposées pour répondre à la question posée :
1) Fun, avec toutes les explications adéquates :
Function IsBisextile(maDate As Date) As Boolean
'Fonction de contrôle de la bisextilité d'une année à partir d'une date
'Les conditions pour avoir une année bisextile sont les suivantes:
' - année divisible par 4 : année bisextile
' - exception : année divisible par 100 : année non bisextile
' - exception de l'exception : année divisible par 400 : année bisextile
If Year(maDate) Mod 4 = 0 And (Year(maDate) Mod 100 <> 0 Or Year(maDate) Mod 400 = 0) Then
IsBisextile = True
Else
IsBisextile = False
End If
End Function2) Moins fun mais tout aussi efficace, par code direct sur le 29 février :
Function IsBisextile(madate As Date) As Boolean
IsBisextile = Day(DateSerial(Year(madate), 3, 0))=29
End FunctionA vous de choisir celle que vous préférez !
A défaut d'utiliser le contrôle Timer, il existe les API SetTimer et KillTimer qui ont l'avantage : * de pouvoir créer un timer sans le contrôle donc éventuellement sous VBA * de pouvoir créer un timer dont la fréquence est codée sur un long, soit une fréquence supérieure à 65535ms, ce qui évite la solution d'appeler une variable publique servant de multiple dans le contrôle timer * de pouvoir créer un timer sans form en faisant pointer sur une classe
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
'-- ici, le code a éxécuter par le Timer
End Sub
Public Sub main()
KillTimer 0, 0
SetTimer 0, 0, 5000, AddressOf TimerProc
End Sub