FORMAT DE DATE SYSTEM ET PORTABILITÉ

---

Commentaire sur cette source (17)
Ajouter un commentaire et/ou une note

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 !

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

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

02 juillet 2007 11:07:00 :

Modifications des requètes d'insertion/lecture

02 juillet 2007 15:55:41 :

Suite aux remarques, la fonction générant le format de la date courte du système à été abandonnée et remplacée par l'API GetLocaleInfo(...)

• CALENDRIER PAR SEMAINE VBA ACCESS
• CALENDRIER PAR MOIS VBA ACCESS

• APPLICATION DE GESTION DE FILMS
• SQL SERVEUR - COMMUNIQUER (REQUÊTE + UPGRADE) - MÉTADONNÉES (VB2008)
• ACCESSTABLESCRIPT
• CONTACTS V2
• CLASSE D'ACCÈS AUX DONNÉES, DAL (GESTION VÉHICULE)

• CONVERTION DE CHAMP TEXTE EN DATE
• VBA EXCEL CONVERTIR EN NOMBRE, APPLIQUER UN FORMAT MONETAIRE OU POURCENTAGE
• VBA EXCEL TRANSFORME UNE DATE ENREGISTRÉE AU FORMAT ANGLAIS (BOGUE D'INVERSION MOIS / JOUR)
• CONVERSION D'UN STRING EN DATE SOUS UN FORMAT DONNÉ
• OBTENIR LA DATE COMPLÈTE (EX: JEUDI 6 SEPTEMBRE 2001) À PARTIR D'UNE DATE AU FORMAT 06/09/2001