Vérifier l’intersection de dates – Episode 2
L’article Vérifier l’intersection de dates nous a permis de mettre en place une fonction VBA capable de vérifier si 2 créneaux de temps se chevauchent. Aujourd’hui, nous allons voir une application pratique de cette fonction, au travers d’un mini système de réservation.
Le principe
Dans ce scénario, vous gérez un hôtel de plusieurs chambres (un hôtel, quoi !). Les réservations sont stockées dans une table (dans le modèle complet, on peut imaginer d’autres tables : Clients, Chambres, etc.).
L’idée consiste à vérifier, avant d’ajouter de nouvelles données dans la table, qu’une nouvelle réservation ne rentre pas en conflit avec une réservation existante. On n’est pas le Carlton de Lille non plus 😉
La table
On dispose d’une table qui contient les informations suivantes (et d’autres encore, inutiles ici) :
Numéro Réservation
(un NuméroAuto)Date Arrivée
(Date/Heure)Date Départ
(Date/Heure)Numéro Chambre
(Numérique)Numéro Client
(Numérique)
Le formulaire
Le formulaire est constitué :
- D’un champ
txtDateArrivee
, au formatjj/mm/aaaa hh:nn
- D’un champ
txtDateDepart
, au formatjj/mm/aaaa hh:nn
- D’une liste déroulante
cmbChambre
qui permet de choisir les numéros de chambres. - D’un bouton
btnVerifier
qui va s’occuper de la vérification des disponibilités pour la chambre choisie.
Le code VBA du formulaire
- Faites apparaître les propriétés du bouton, onglet Événements.
- Renseignez l’événement
Sur clic
surProcédure événementielle
. - Cliquez sur les points de suspension à droite de l’événement.
- Recopiez le code VBA suivant :
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 |
Private Sub btnVerifier_Click() Dim strSQL As String Dim strCritere As String ' Vérifier que toutes les infos sont renseignées If IsNull(Me.txtDateArrivee) _ Or IsNull(Me.txtDateDepart) _ Or IsNull(Me.cmbChambre) Then MsgBox "Toutes les informations doivent être renseignées !", _ vbExclamation Exit Sub End If ' Chaîne SQL de base strSQL = _ "(DatesIntersect({0}, {1}, [Date Arrivée], [Date Départ]) = True)" _ & " AND ([Numéro Chambre] = {2})" ' Critère final strCritere = StringFormat(strSQL, _ DateHeureUS(Me.txtDateArrivee), _ DateHeureUS(Me.txtDateDepart), _ Me.cmbChambre) ' Si au moins 1 enregistrement répond au critère, ' la période est déjà réservée... If DCount("*", "tbl Réservations", strCritere) > 0 Then MsgBox "Une réservation existe déjà sur cette période !", _ vbExclamation Else MsgBox "La période est disponible pour cette chambre.", _ vbInformation End If End Sub |
DateHeureUS()
et la fonction StringFormat()
. Consultez les articles Dates anglo-saxonnes et Marre des concaténations ? pour récupérer ces fonctions dans votre propre base de données.Explications
Le bouton procède en 3 temps :
- Dans un premier temps, on vérifie que les 3 informations ont bien été renseignées par l’utilisateur. Il est inutile de continuer si ce n’est pas le cas !
- Ensuite, on construit le filtre SQL qui va chercher – pour la chambre concernée – une intersection entre les dates souhaitées et les dates de la table de réservations. J’ai décomposé la construction du critère en 2 chaînes pour que vous voyiez mieux le processus. C’est à ce niveau que la fonction
StringFormat()
nous épargne des concaténations laborieuses… - Enfin, on utilise la fonction
DCount()
pour compter les réservations répondant au critère (donc les réservations en conflit avec la période cherchée). On aurait pu aussi utiliserDLookup()
pour trouver la première réservation en conflit (au lieu de compter toutes les réservations).
J’ai respecter le tuto mais une erreur apparaît à chaque fois au niveau de la fonction string format (). Je ne vois pas d’où cela peut venir.
Est-ce que la fonction
StringFormat()
est bien présente dans la base de données, comme indiqué dans le bloc « Important », en fin d’article ?PJ > J’ai jeté un œil rapide à la base : le problème ne vient sans doute pas du nombre de lignes (pas de raison), mais il peut venir du fait que certaines dates ne sont pas alimentées (valeur
Null
). Du coup, ça va « casser » la fonctionDateIntersect()
.Pour info, de quelle version d’Access s’agit-il ?
Re-Bonjour,
Je viens de voir quelque chose qui peux être intéréssant : J’ai éffacé toutes les données de ma table réservation et comme par magie le formulaire a refonctioné. Je pense donc que c’est un problème de nombre d’enregistrements.
Comment palier à ce problème ?
Cdt
J’ai également mis mon appli ici pour ceux qui voudrais jeter un coup d’oeuil plus approfondit
http://cjoint.com/?0CCjcSdkVjR
Bonjour,
Les dates sont bien en Dates/Heure et le champ Voiture est un texte. Ce qu’il se passe c’est que je lie ma table « réservation » à un Sharepoint. Tout ce passe très bien, puis cette erreure arrive dès le lendemain et je ne comprends pas d’où cela peut il venir.
Cordialement
PJ > Est-ce que les dates sont bien de type Date/Heure dans la table ?
Et de quel type est le champ Voiture ? Si c’est un numérique, le critère ne doit pas avoir d’apostrophes. Du genre :
[Voiture] = {2}
Bonjour,
J’ai suivit à la lettre le tuto, cependant lorsque je clique sur mon bouton réserver l’erreure suivante s’affiche ‘erreur d’execution 3464’ Type de données incompatible dans l’expression du critère
Je ne comprends pas d’où sa viens . Voici mon code ( Date1 = date de départ et Date 2 = date de retour) :
Private Sub Commande18_Click()
Dim strSQL As String
Dim strCritere As String
‘ Vérifier que toutes les infos sont renseignées
If IsNull(Me.Date1) _
Or IsNull(Me.Date2) _
Or IsNull(Me.Voiture) Then
MsgBox « Toutes les informations doivent être renseignées ! », _
vbExclamation
Exit Sub
End If
‘ Chaîne SQL de base
strSQL = _
« (DatesIntersect({0}, {1}, [Date1], [Date2]) = True) » _
& » AND ([Voiture] = ‘{2}’) »
‘ Critère final
strCritere = StringFormat(strSQL, _
DateHeureUS(Me.Date1), _
DateHeureUS(Me.Date2), _
Me.Voiture)
‘ Si au moins 1 enregistrement répond au critère,
‘ la période est déjà réservée…
If DCount(« * », « Réservation », strCritere) > 0 Then
MsgBox « Une réservation existe déjà sur cette période ! », _
vbExclamation
Else
MsgBox « Réservation éffectuée « , _
vbInformation
End If
End Sub
max > Le «
MsgBox
» doit être sur sa propre ligne, pas après leThen
. Du style :Bonjour Hervé
j’ai une erreur ac le code suivant: VB ne reconnait pas le IF et le Else réclame son IF…
‘ Si au moins 1 enregistrement répond au critère,
‘ la période est déjà réservée…
If DCount(« * », « location », strCritere) > 0 Then MsgBox « Une réservation existe déjà sur cette période ! », vbExclamation
Else
MsgBox « La période est disponible pour cette chambre. », vbInformation
End If
End Sub
merci
Demba Badji > Il faut aussi recopier dans le projet la fonction
DatesIntersect()
, qui est fournie dans l’article précédent.Bonjour Mr Inisan
Je viens solliciter un coup de main. en effet j’ai essayé de refaire le mini système de réservation cité en exemple ci-dessus mais quand je clique sur le bouton Verifier la disponibilité, je reçois le message ‘Erreur d’exécution 3085 fonction <<DatesIntersect>> non définies dans l’expression’
Merci de m’aider
Justinien > Il y a plusieurs erreurs dans la base :
StringFormat()
est complètement incorrecte (il faut la reprendre intégralement sur la page du site correspondante). La tienne contient actuellement un exemple avec du SQL.DLookup()
est «Réservation
» et pas «Reservation
« .{2}
, parce que ton champVoiture
est de type Texte).Bonjour,
Je rencontre le même problème que Uls, j’ai une erreur ’13’ et je me demandais si il étais possible que tu y jette un coup d’oeuil
Voici le lien de mon app Access: http://dl.free.fr/kURngBFyb
Merci d’avance
Max > Avant toute chose, est-ce que tu as bien la fonction
StringFormat()
dans ta base ?Bonjour,
Je réalise un outil pour des réservations de matériel, et je voudrai utiliser ce code VBA mais j’ai un problème similaire au posts précédents.
Le code bloque au niveau du « strCritere = StringFormat(…) ».
J’ai fait plusieurs test avec les formats,les masques de mes dates au niveau du champs dans réservations et dans le formulaire mais sa ne fonctionne toujours pas.
Es que quelqu’un pourrai m’aider ?
Je peut envoyer ma base si besoin. Merci d’avance.
Supersayan > Merci pour le retour !
Merci beaucoup Hervé!!
Il semblerait que cela fonctionne correctement avec ce changement.
J’avais testé un paquet de possibilités en retirant ou en ajoutant des DateUS mais à priori pas celle-là. Le truc c’est que je n’avais pas compris/vu que la fonction DateUS renvoyait une chaine donc je cherchait à débugger les yeux fermés..
Désolé pour le temps de réaction mais j’étais en déplacement.
Encore merci pour l’aide, rapide et efficace! Impressionnant!
Supersayan > La fonction
DateInsersect()
reçoit 4 dates. Dans ton cas, tu appliques unDateUS()
sur les 2 dernières dates, ce qui les convertit en chaînes. Du coup, tu passes 2 dates + 2 chaînes. D’où le message d’erreur (type incompatible). En enlevant lesDateUS()
dans la chaînestrSQL
, ça passe.Ouala !
Bonjour,
Cette application m’intéresse beaucoup pour une BDD où je cherche à valider si une période de travail pour une personne est déjà utilisée…
Le test est donc exactement le même que pour les chambres d’hôtel mais avec des personnes.
Je n’arrive cependant pas à utiliser la fonction, je suis bloqué par un format de date. J’ai passé des heures à passer en US/FR les dates, passer en short Date ou General Date. Pas pu trouver d’où venait le souci.
Du coup en dernier recours, je vous fais parvenir un exemple de ma BDD pour voir si vous pouvez me donner un coup de main.
J’ai fait un paquet de test donc certaines fonctions peuvent avoir été un peu modifiées.
Merci d’avance de votre aide.
http://cjoint.com/?0CnoHXmafMd
Uls > Super ! Content que ça marche…
Hourraaa!!!!
Hervé, tu es trop fort!! ça marche, j’ai eu l’affichage.
Merci
Uls > C’est tout de suite plus facile comme ça. 🙂
En fait, il y a 3 erreurs dans la base :
Non
). C’est ça qui pose le problème de type incompatible, parce que les données transmises àStringFormat(
) n’avaient pas de sens pour un numérique. A noter que ce réglage ne peut pas être inversé : il faut détruire le champ et le reconstruire pour repartir correctement.DCount()
: la table doit s’appeler «Reservation
« , alors que la mienne s’appelle «tbl Reservations
« .[Date Arrivée]
et[Date Départ]
, sans souligné ni « Me. ». Ce sont les noms exacts des champs de tables, crochets en plus.J’ai envoyé la base sur ce lien:
http://cjoint.com/?0LpmQ6Xtnzt
Uls > C’est compliqué de diagnostiquer le problème à distance. Le mieux est peut-être de poster la base sur un site, et de me donner l’adresse. J’y jetterai un oeil.
Voir cette page pour l’envoi de la base (sauf le dernier paragraphe qui concerne les forums).
Oups! il y a le # à la fin de la deuxième date
Uls > Il n’y a pas de # en fin de deuxième date ?
J’ai placer la ligne et j’ai:
Indice = 0
valeur:#02/12/2011#
en appuyant sur OK,
on a:
Indice = 1
Valeur:#12/2/2011
après c’est le bug
Uls > Qu’est-ce qui s’affiche si on ajoute ceci :
avant cette ligne de la fonction
StringFormat()
:Les champs de la table sont de type Date/heure
Il y a quelque chose qui cloche chez moi mais je ne sais pas où
Uls > Normalement, la fonction
DateHeureUS()
se charge de la transformation au format anglais. Dans mon cas, j’utilise par exemple le format françaisjj/mm/aaaa hh:n
n, défini comme masque de saisie surtxtDateArrivee
ettxtDateDepart
(voir les captures d’écran).Les champs de la table sont bien aussi de type Date/Heure ?
Cette ligne est écrite comme vous la présentez: « strCritere = StringFormat(…) »
je pense que le problème est sur la saisie des dates. En fait je rentre la date avec le calendrier access. Faut-il que je la saisise en format US?
Uls > Comment est la écrite la ligne qui construit la variable
strCritere
:strCritere = StringFormat(...)
?Et est-ce que les champs
Date Arrivée
etDate Départ
sont bien saisis sous forme de dates ?Bonjour Hervé,
J’ai mis les fonction dans un module standard. Il y a un changement.
Access indique: »erreur d’exécution ’13’: Incompatibilité de type.
dans le module standard, voici la ligne en jaune:
strChaine = Replace(strChaine, « { » & intI & « } », Nz(varValeurs(intI)))
Uls > Les blocs
Function / End Function
etSub / End Sub
ne doivent pas être imbriqués (ils peuvent seulement être juxtaposés). Donc il ne faut pas recopier les fonctions commeStringFormat()
ouDateHeureUS()
dans le code du bouton. Il faut par contre les recopier les unes après les autres dans un module standard. Ça permettra de les réutiliser pour d’autres usages.Normalement, VBA devrait pour l’instant indiquer une erreur de compilation, puisque l’imbrication des blocs pose problème.
J’ai essayé le programme mais pas d’action,
Voici mon programme:
Private Sub Commande13_Click()
Dim strSQL As String
Dim striCritere As String
‘ Déclaration de la fonction StringFormat
Function StringFormat( _
ByVal strChaine As String, _
ParamArray varValeurs() As Variant) As String
Dim intI As Integer
For intI = LBound(varValeurs) To UBound(varValeurs)
strChaine = Replace(strChaine, « { » & intI & « } », Nz(varValeurs(intI)))
Next
StringFormat = strChaine
‘ Déclaration de la fonction DateHeureUS
Function DateHeureUS(ByVal dt As Variant)
If IsNull(dt) Then Exit Function
DateHeureUS = « # » & Month(dt) & « / » & Day(dt) & « / » & Year(dt) _
& » » & Format(dt, « hh:nn:ss ») & « # »
‘ Vérifier que toutes les infos sont renseignées
If IsNull(Me.Date_Arrivée) _
Or IsNull(Me.Date_départ) _
Or IsNull(Me.Numéro_Chambre) Then
MsgBox « Toutes les informations doivent êtres renseignées! », _
vbExclamation
Exit Function
End If
‘ Chaîne SQL de base
strSQL = _
« (DatesIntersect({0}, {1}, [Date_Arrivée], [Date_départ]) = True) » _
& » AND ([Numéro Chambre] = {2}) »
‘ Critère final
strCritere = StringFormat(strSQL, _
DateHeureUS(Me.Date_Arrivée), _
DateHeureUS(Me.Date_départ), _
Me.Numéro_Chambre)
‘ Si au moins 1 enregistrement répond au critère,
‘ la période est déjà réservée…
If DCount(« * », « Reservation », strCritere) > 0 Then
MsgBox « Une réservation existe déjà sur cette période ! », _
vbExclamation
Else
MsgBox « La période est disponible pour cette chambre. », _
vbInformation
End If
End Sub