Format de date system et portabilité

Soyez le premier à donner votre avis sur cette source.

Vue 11 431 fois - Téléchargée 625 fois

Description

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

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Renfield
Messages postés
17308
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
22 août 2018
53 -
utilises simplement la version Unicode de l'API
les controles de Access le gèrent.

Private Declare Function GetLocaleInfo Lib "kernel32.dll" Alias "GetLocaleInfoW" ( _
ByVal locale As Long, _
ByVal lctype As Long, _
ByVal lplcdata As Long, _
ByVal cchdata As Long _
) As Long


et dans le code :

nretval = GetLocaleInfo(locale, type_retour, StrPtr(lplcdata), cchdata)
pillsmen
Messages postés
27
Date d'inscription
samedi 27 mai 2006
Statut
Membre
Dernière intervention
3 juillet 2007
-
Merci, ça marche nickel :)

Par curiosité quel est le rôle de la fonction StrPtr(..) ? je n'ai pas trouvé dans l'aide ds VBA.

Pendant que j'y suis :p, j'ai encore un p'tit problème avec les dates.
J'ai créé et posté sur ce site 2 formulaires access de calendriers entièrement gérés par labels (pas d'APIs). Je pense que la gestion des dates doit aussi y être catastrophique que ce que j'avais fait précédemment pour cette source!

http://www.vbfrance.com/codes/CALENDRIER-SEMAINE-VBA-ACCESS_42640.aspx
http://www.vbfrance.com/codes/CALENDRIER-MOIS-VBA-ACCESS_42460.aspx

Le problème c'est que je dois générer une date à partir de variables (une pour le jour, une pour le mois, une pour l'année). Je le fesait grâce à la fonction cdate style cdate(num_jour & "/" & num_mois & "/" & num_annee) mais le code n'est, par conséquent, pas portable.
(je voulais le faire notamment pour cette source afin d'initialiser la table avec des dates aléatoires)

A ce jour, la solution que j'ai trouvé serait d'utiliser une variable représentant le nombre de jours entre la date désirée et la date actuelle et de généré la date au format "local" avec dateadd(...). Je ne sais pas si c'est la bonne solution, ou s'il en existe une meilleur en jouant sur la fonction Format(...).
Une idée ? :)
Renfield
Messages postés
17308
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
22 août 2018
53 -
VB a été concu pour 98 (& co)...

Unicode, moyena l'époque.
bien que VB stockes en interne, les string en Unicode, les parametres de type String sont retransformés en ASCII lors des appels aux APIs

StrPtr nous donne l'adresse de la chaine, ce qui interesse finallement l'API, qui n'y voit que du feu...

seulement, le parametre n'est plusun String, VB laisse la chaine en Unicode
(note le W dans le nom de l'API)
Renfield
Messages postés
17308
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
22 août 2018
53 -
pour la fonction que tu cherches, c'est DateSerial (TimeSerial, pour les heures)
pillsmen
Messages postés
27
Date d'inscription
samedi 27 mai 2006
Statut
Membre
Dernière intervention
3 juillet 2007
-
Super c'est exactement ce qu'il me fallait :)
Merci encore Renfield
Commenter la réponse de cs_DARKSIDIOUS

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.