Ce bout de code a été écrit afin gérer les dates (insertion et lecture dans la base de données) quelque soit les paramètres régionnaux du système (en supposant que l'utilisateur saisie une date dans le format de son pays, message d'erreur si ce n'est pas le cas).
J'ai eu à écrire ce code à cause de la non portabilité d'un programme utilisé dans des pays étrangers dû au format des dates.
Une des fonctions disponible dans ce code permet donc de récupérer le format du système afin d'informer l'utilisateur sur comment renseigner les dates en vue d'une insertion. Cette fonction retourne une chaîne type 'dd/mm/yyyy' (d pour jour, m pour mois, y pour année) qui sera affichée dans un label.
Pour tester ce code, modifier les paramètres régionnaux de votre système (sous XP, dans Panneau de configuration > Options régionnales et linguistiques)) et relancer le formulaire à chaque modifications
Ce code n'a été testé que sous XP !
Source / Exemple :
Option Compare Database
Option Explicit
'Déclaration des APIs
Private Declare Function GetLocaleInfo Lib "kernel32.dll" Alias "GetLocaleInfoA" ( _
ByVal locale As Long, _
ByVal lctype As Long, _
ByVal lplcdata As String, _
ByVal cchdata As Long _
) As Long
Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
'Constante passée à la fonction GetLocaleInfo afin qu'elle renvoie le format de la date courte
' Pour plus d'infos et avoir la liste des constantes http://support.microsoft.com/kb/177146/fr
Const Format_Date_Courte = &H1F
Private Sub Form_Load()
'On initialise le label avec le format de la date courte renvoyé par le systeme
format_date.Caption = ReturnFormat(Format_Date_Courte) 'retour du format de la date courte
End Sub
Private Sub Inserer_Click()
Dim request As String
'On empêche tout message d'alerte en cas d'insertion dans la base de données
DoCmd.SetWarnings False
'On test si la date à insérer est bien une date
If Not IsDate(date_test.Value) Then
'Message d'erreur si ce n'est pas le cas
MsgBox "erreur!", vbCritical
Else
'Sinon, on insère la date dans la table concernée
'Copnstruction de la requête
request = "INSERT INTO test (date_test) VALUES (#" & Format$(date_test.Value, "MM\/DD\/YYYY") & "#);"
'Exécution de la requête
DoCmd.RunSQL request
End If
End Sub
Private Sub Chercher_Click()
'Fonction qui compte le nombre de date recherchée dans la base de donnée
Dim request As String
Dim rst As DAO.Recordset
'On test si la date à insérer est bien une date
If Not IsDate(date_recherche.Value) Then
'Message d'erreur si ce n'est pas le cas
MsgBox "erreur!", vbCritical
Else
'Sinon, on recherche la date dans la table
'Construction de la requête
request = "SELECT Count(1) AS Nb " & _
"FROM test " & _
"WHERE test.date_test=#" & Format$(date_recherche.Value, "MM\/DD\/YYYY") & "#;"
Set rst = CurrentDb.OpenRecordset(request, dbOpenDynaset, dbReadOnly)
'Affichage du résultat
MsgBox "Nb de """ & CDate(date_recherche.Value) & """ : " & rst("Nb")
End If
End Sub
Private Function ReturnFormat(type_retour As String) As String
'Création du format de la date system
Dim locale As Long, lctype As Long, lplcdata As String, cchdata As Long, nretval As Long, dwLCID As Long
'Préparation des paramètres de la fonction GetLocaleInfo
locale = GetUserDefaultLCID()
lplcdata = Space(255)
cchdata = Len(lplcdata)
nretval = 0
'On récupère le format de la date dans le tableau lplcdata
nretval = GetLocaleInfo(locale, type_retour, lplcdata, cchdata)
'Dans le cas ou la valeur de retour est 0 => on renvoie vide ""
If nretval = 0 Then
ReturnFormat = ""
Else
'Sinon on renvoie le format de la date
ReturnFormat = LCase(lplcdata)
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.