IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Hep Taxi !

Application Access pour gérer des réservations de transports à la demande (TAD)

Une nouvelle fois un tutoriel pour montrer combien Access permet de réaliser des outils de gestion pratiques en peu de temps.

Dans celui-ci, nous aborderons les techniques suivantes :

- les formulaires pères/fils ;

- la recherche multicritère ;

- l'interaction d'Access et d'Outlook.

Pour réagir à ce tutoriel, un espace de discussion vous est proposé sur le forum :3 commentaires Donner une note à l´article (5) 

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Le contexte

Il s'agit de mettre en place quelques formulaires pour que l'équipe du CRC (Centre de Relation Clients) puisse :

- enregistrer une demande de réservation ;

- enregistrer l'annulation éventuelle d'une réservation ;

- notifier ces réservations et annulations à la compagnie de taxis ;

- vérifier la concordance entre les réservations comptabilisées et la facturation adressée par les compagnies de taxis.

II. Modéliser l'offre de transports

II-A. Première étape : le réseau

Il se compose de lignes et chaque ligne comporte plusieurs arrêts.

Par exemple,
- la ligne : 24 FONTAINE S/ SOMME - LONGPRE LES CORPS SAINTS,

- comporte les arrêts : 1) FONTAINE S/SOMME, 2) LONG LE CATELET et 3) LONGPRE LES CORPS SAINTS.

II-A-1. Deux tables pour enregistrer ces données 

Image non disponible

II-A-2. Un formulaire père-fils pour l'encodage

Image non disponible
Image non disponible
Si la technique des formulaires pères/fils ne vous est pas familière, consultez ce tutoriel : Comment classer les données dans des tables liées et construire un formulaire père/fils.

II-B. Deuxième étape : préciser les horaires

Pour chaque ligne, il faut annoncer :

  • les jours de circulation ;
  • le sens (aller ou retour) ;
  • l'heure de chaque arrêt.

Nous intégrons ici la notion de compagnie de taxis qui assure le service.

II-B-1. Le modèle de données s'étoffe un peu

Image non disponible

III. Encoder l'horaire d'une ligne : formulaire fEncoHorLigne

III-A. À l'ouverture

fEncoHorLigne se présente comme ceci :

Image non disponible

C'est un formulaire père avec trois fils : sfEncoHorArrets, sfEncoHorValid et sfEncoHorValidSauf.
Chacun a comme source la table indiquée sur la figure ci-dessus.
À l'ouverture, ces tables sont réinitialisées.

 
Sélectionnez
Private Sub Form_Open(Cancel As Integer)
  'Purger tEncoHorArrets,tEncoHorValid, tEncoHorValidSauf
  DoCmd.SetWarnings False
  DoCmd.RunSQL "Delete * From tEncoHorArrets"
  DoCmd.RunSQL "Delete * From tEncoHorValid"
  DoCmd.RunSQL "Delete * From tEncoHorValidSauf"
  DoCmd.SetWarnings True
  Me.Refresh
End Sub

Private Sub Form_Current()
  Dim ctl As Control
  'Réinitialiser
  Me.cboLigne = ""
  Me.CaSens = -1
  Me.txtNumCirculation = Null
  Me.cboTaxis = Null
  For Each ctl In Me.Controls
    If ctl.Name Like "chk*" Then ctl = -1
  Next ctl
  Me.Refresh
End Sub

Le formulaire va permettre à l'utilisateur de compléter ces quatre tables de transit : un clic sur Image non disponible provoquera ensuite le transfert vers les tables cibles (tHorLignes, tHorArrets, tHorValid et tHorValidSauf).

III-B. L'utilisateur choisit une ligne dans la liste déroulante

 
Sélectionnez
Private Sub cboLigne_AfterUpdate()
  Dim strSQL As String
  Me.Refresh
  
  'Purger tEncoHorArrets,tEncoHorValid, tEncoHorValidSauf
  DoCmd.SetWarnings False
  DoCmd.RunSQL "Delete * From tEncoHorArrets"
  DoCmd.RunSQL "Delete * From tEncoHorValid"
  DoCmd.RunSQL "Delete * From tEncoHorValidSauf"
  'Créer la structure des arrêts
  DoCmd.OpenQuery "rStructureArrets"
  DoCmd.SetWarnings True
  Me.CTNRsfEncoHorArrets.Form.Requery
End Sub
Image non disponible

Si l'utilisateur veut encoder un horaire pour le sens Retour, il coche le bouton radio et l'ordre des arrêts s'inverse :

 
Sélectionnez
Private Sub CaSens_AfterUpdate()
  'ordonner le sous-formulaire
  If Me.CaSens = -1 Then
       Me.CTNRsfEncoHorArrets.Form.RecordSource = _
                    "SELECT * FROM tEncoHorArrets ORDER BY EncoSequence;"
    Else
       Me.CTNRsfEncoHorArrets.Form.RecordSource = _
                    "SELECT * FROM tEncoHorArrets ORDER BY EncoSequence DESC;"
  End If
End Sub
Image non disponible
 
Sélectionnez
Private Sub CaSens_AfterUpdate()
  'ordonner le sous-formulaire
  If Me.CaSens = -1 Then
       Me.CTNRsfEncoHorArrets.Form.RecordSource = _
                    "SELECT * FROM tEncoHorArrets ORDER BY EncoSequence;"
    Else
       Me.CTNRsfEncoHorArrets.Form.RecordSource = _
                    "SELECT * FROM tEncoHorArrets ORDER BY EncoSequence DESC;"
  End If
End Sub

III-C. L'utilisateur complète les données

Image non disponible

III-D. Quand toutes les données sont encodées

Le clic sur le bouton Image non disponible déclenche le code suivant :

 
Sélectionnez
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.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
Private Sub Btjouter_Click()
  Dim lngCle As Long
  Dim oRst As DAO.Recordset
  Dim oQry As DAO.QueryDef
  Dim dHeure As Date
  Me.Refresh
  'Champs obligatoires présents
  If IsNull(Me.txtNumCirculation) + IsNull(Me.cboTaxis) <> 0 Then
      MsgBox "Un champ obligatoire n'est pas rempli !", vbCritical
      Exit Sub
  End If
  'Vérifer que cette circulation n'est pas déjà répertoriée
  If DCount("*", "tHorLignes", "tLignesFK = " & Me.cboLigne _
                            & " AND NumCirculation =" & Me.txtNumCirculation) <> 0 Then
      MsgBox "Cette circulation est déjà répertoriée", vbCritical
      Exit Sub
  End If
  'Vérifier ordre chronologique des arrêts
  Set oRst = Me.CTNRsfEncoHorArrets.Form.RecordsetClone
  oRst.MoveFirst
  dHeure = oRst("EncoArretHeure")
  oRst.MoveNext
  Do Until oRst.EOF
    If oRst("EncoArretHeure") <= dHeure Then
        MsgBox "Chronologie incohérente !", vbCritical
        Exit Sub
    End If
    dHeure = oRst("EncoArretHeure")
    oRst.MoveNext
  Loop
  'Libérer oRst
  oRst.Close
  Set oRst = Nothing
  'Vérifier qu'au moins une période de validité est spécifiée
  If DCount("*", "tEncoHorValid") = 0 Then
      MsgBox "La période de validité manque !", vbCritical
      Exit Sub
  End If
  'Ajouter dans tHorLignes
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "rAJOUTtHorLignes"
  'Récupérer le N° attribué à tHorLignesPK
  lngCle = DMax("tHorLignesPK", "tHorlignes")
  'Ajouter dans tHorArrets
  Set oQry = CurrentDb.QueryDefs("rAJOUTtHorArrets")
      oQry.Parameters("Ligne") = lngCle
      oQry.Execute
  'Ajouter dans tHorValid
  Set oQry = CurrentDb.QueryDefs("rAJOUTtHorValid")
      oQry.Parameters("Ligne") = lngCle
      oQry.Execute
  'Ajouter dans tHorValidSauf
  Set oQry = CurrentDb.QueryDefs("rAJOUTtHorValidSauf")
      oQry.Parameters("Ligne") = lngCle
      oQry.Execute
  'Libérer oQry
  Set oQry = Nothing
  
  DoCmd.SetWarnings True
  'Réinitialiser pour un suivant éventuel
  Call Form_Open(0)
  Call Form_Current
End Sub

Commentaires du code

7 - 38 : on vérifie que les données sont cohérentes.

41 - 55 : on reporte le contenu des tables tEncoHor* dans les tables tHor*.

Image non disponible

IV. Encoder une réservation

Image non disponible
Image non disponible
Image non disponible
Image non disponible

IV-A. À l'ouverture du formulaire : choix du client

 
Sélectionnez
Private Sub Form_Open(Cancel As Integer)
  Me.cboClient.SetFocus
  Me.cboClient.Dropdown
End Sub

La liste des clients se déploie.

Le choix du client provoque le déploiement de la liste des lignes :

 
Sélectionnez
Private Sub cboClient_AfterUpdate()
  Me.cboLigne.SetFocus
  Me.cboLigne.Dropdown
End Sub

IV-B. Choix du trajet

Quand l'opérateur choisit une ligne, de deux choses l'une :

- soit cette ligne ne comporte que deux arrêts : le point de départ et le point de destination sont donc déterminés d'office ;

- soit la ligne comporte des arrêts intermédiaires, la liste de ceux-ci est proposée au choix, à remarquer que le terminus ne fait pas partie des départs possibles.

Quand le départ a été choisi, à nouveau de deux choses l'une :

- soit l'arrêt suivant est le terminus, c'est donc la destination ;

- soit ce n'est pas le cas et une liste contenant les arrêts suivants est proposée à l'utilisateur.

 
Sélectionnez
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.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
Private Sub cboLigne_AfterUpdate()
  Dim oQry As DAO.QueryDef
  'Libérer Me.cboDepart.RowSource et cboDestination.RowSource
  Me.cboDepart.RowSource = ""
  Me.cboDepart = ""
  Me.cboDestination.RowSource = ""
  Me.cboDestination = ""
  
  'Garnir la source de CboDepart
  DoCmd.SetWarnings False
  DoCmd.RunSQL "Delete * From tCboDepart"
  Set oQry = CurrentDb.QueryDefs("rReservationGarnirCboDepart")
  oQry.Parameters("Ligne") = Me.cboLigne
  oQry.Parameters("Sens") = Me.cboLigne.Column(2)
  oQry.Execute
  'Éliminer le terminus en tant que point de départ
  DoCmd.OpenQuery "rReservationEliminerTerminusDepart"
  'Affecter tCboDepart à cboDepart
  Me.cboDepart.RowSource = "SELECT *  FROM tCboDepart ORDER BY ArretHeure;"
  'S'il n'y a qu'un seul élément, on l'affecte.Sinon on déploie.
  If Me.cboDepart.ListCount > 1 Then
      Me.cboDepart.SetFocus
      Me.cboDepart.Dropdown
      GoTo Sortie
    Else
      Me.cboDepart = Me.cboDepart.ItemData(0)
      Call cboDepart_AfterUpdate
  End If
Sortie:
 DoCmd.SetWarnings True
 Set oQry = Nothing
End Sub

Private Sub cboDepart_AfterUpdate()
  'Libérer cboDestination.RowSource
  Me.cboDestination.RowSource = ""
  Me.cboDestination = ""
  DoCmd.SetWarnings False
  'Créer la table tCboDestination
  DoCmd.OpenQuery "rReservationGarnirCboDestination"
  'Affecter tCboDestination à cboDestination
  Me.cboDestination.RowSource = "SELECT tArretsFK, ArretNom, ArretHeure " _
                             & "FROM tCboDestination ORDER BY ArretHeure;"
  'S'il n'y a qu'un seul élément, on l'affecte. Sinon on déploie.
  If Me.cboDestination.ListCount > 1 Then
      Me.cboDestination.SetFocus
      Me.cboDestination.Dropdown
      GoTo Sortie
    Else
      Me.cboDestination = Me.cboDestination.ItemData(0)
      Call cboDestination_AfterUpdate
  End If
Sortie:
 DoCmd.SetWarnings True
End Sub

Private Sub cboDestination_AfterUpdate()
  'Si les champs utiles sont remplis, construire la structure d'une réservation
  If IsNull(Me.cboClient) + IsNull(Me.cboLigne) _
            + IsNull(Me.cboDepart) + IsNull(Me.cboDestination) = 0 _
            Then Call ConstruireReservation
  Me.EtiCochez.Visible = True
  Me.EtiNbre.Visible = True
  Me.EtiObservations.Visible = True
End Sub

Commentaires du code

4 - 7 : on réinitialise les zones de liste Départ et Destination.

11 - 15 : on confectionne la liste des arrêts de la ligne en exécutant la requête paramétrée :

Image non disponible

17 : et on élimine ensuite le terminus :

Image non disponible

34 - 55 : cas où plusieurs points de départ étaient possibles => confection de la liste des points de destination offerts.

57 - 64 : quand la destination est aussi déterminée,

  • on vérifie que les champs obligatoires sont complétés (59 - 60),
  • on déclenche la Sub ConstruireReservation (61), elle est décrite au § suivant,
  • on rend visibles les étiquettes pour la liste qui va s'afficher (62 - 64).

IV-C. Comptabilisation de la réservation

Quand l'opérateur a coché les dates demandées par le client, un clic sur le bouton « Comptabiliser les réservations » :
- un e-mail décrivant le détail est envoyé automatiquement à la compagnie de taxis qui opère sur la ligne ;
- la table tReservations est complétée.

 
Sélectionnez
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.
Private Sub BtCompta_Click()
  Dim oCtl As Control
  Dim oQry As DAO.QueryDef

  Me.Refresh
  'Vérif présence du code opérateur
  If IsNull(Me.cboOperateur) Then
      MsgBox "Opérateur ?", vbCritical
      Me.cboOperateur.SetFocus
      Me.cboOperateur.Dropdown
      Exit Sub
  End If
  'Envoi de l'e-mail de réservation
  Call EnvoiMailRes
  'Enregistrement de la réservation
  DoCmd.SetWarnings False
  Set oQry = CurrentDb.QueryDefs("rReservationCompta")
  oQry.Parameters("Client") = Me.cboClient
  oQry.Parameters("Ligne") = Me.cboLigne
  oQry.Parameters("Operateur") = Me.cboOperateur
  oQry.Execute
  DoCmd.SetWarnings True
  Set oQry = Nothing
  Me.Section("Détail").Visible = False
  For Each oCtl In Me.Controls
    If oCtl.Name Like "Eti*" Then oCtl.Visible = False
    If oCtl.Name Like "Cbo*" Then oCtl = Null
  Next oCtl
  Me.cboClient.SetFocus
  Me.cboClient.Dropdown
End Sub

Commentaires du code

14 : la routine EnvoiMailRes est décrite plus loin dans ce tutoriel.

17 - 21 : on exécute la requête rReservationCompta

Image non disponible

24 - 30 : on remet le formulaire en forme pour la réservation suivante.

V. La routine ConstruireReservation

 
Sélectionnez
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.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
Public Sub ConstruireReservation()
  Dim i As Integer
  Dim oRst As DAO.Recordset
  Dim oRst2 As DAO.Recordset
  Dim DateValide As Date
  Dim oQry As DAO.QueryDef
  DoCmd.SetWarnings False
  
  '----------------------------------------------------'
  'Garnir tUneReservation avec toutes les dates valides'
  '----------------------------------------------------'
      'Vidanger tUneReservation
      '------------------------
  DoCmd.RunSQL "Delete * from tUneReservation;"
      'Garnir tDatesValides pour les périodes de validation
      '----------------------------------------------------
  Set oRst = CurrentDb.OpenRecordset("SELECT  ValidDu, ValidAu FROM tHorValid " _
                                     & "WHERE tHorLignesFK=" & Me.cboLigne & ";")
  Set oQry = CurrentDb.QueryDefs("rReservationDatesFutures")
  Do While Not oRst.EOF
      If oRst("ValidAu") > Date Then
          DateValide = IIf(oRst("ValidDu") >= Date, oRst("ValidDu"), Date + 1)
          Do While DateValide <= oRst("ValidAu")
            oQry.Parameters("LaDate") = DateValide
            oQry.Parameters("Depart") = Me.cboDepart
            oQry.Parameters("Destination") = Me.cboDestination
            oQry.Execute
            DateValide = DateValide + 1
          Loop
      End If
      oRst.MoveNext
  Loop

      'Supprimer les jours de la semaine non servis
      '--------------------------------------------
         'Chercher la liste des jours non servis
  Set oRst = CurrentDb.OpenRecordset("tHorLignes", dbOpenDynaset)
  oRst.FindFirst "[tHorlignesPK] = " & Me.cboLigne
         ' faire défiler tous les jours d'une semaine pour accéder aux colonnes de tHorLignes
  Set oQry = CurrentDb.QueryDefs("rReservationJoursSemSans")
  For i = 1 To 7
    If oRst(Format(Date + i, "dddd")) = False Then
        oQry.Parameters("JoursSemSans") = Format(Date + i, "dddd")
        oQry.Execute
    End If
  Next i
     'Supprimer les jours ordinaires fériés
     '-------------------------------------
  Set oQry = CurrentDb.QueryDefs("rReservationSuppressionJF")
  oQry.Parameters("SaufFete") = oRst("SaufFete")
  oQry.Execute
     'Ajouter les dates fériées si roule tous les jours fériés
     '--------------------------------------------------------
  If oRst("TousLesFeries") = True Then
      Set oQry = CurrentDb.QueryDefs("rReservationTousJrsFeries")
      'Rechercher les périodes de validité de cette ligne
      Set oRst2 = CurrentDb.OpenRecordset("SELECT ValidDu, ValidAu FROM tHorValid WHERE tHorLignesFK=" & Me.cboLigne & ";")
      'Ajouter les dates fériées valides à venir
      Do While Not oRst2.EOF
        If Date >= oRst2("ValidDu") And Date <= oRst2("ValidAu") Then
            oQry.Parameters("ValidAu") = oRst2("ValidAu")
            oQry.Parameters("Depart") = Me.cboDepart
            oQry.Parameters("Destination") = Me.cboDestination
            oQry.Execute
        End If
        oRst2.MoveNext
      Loop
  End If
    'Supprimer les dates exclues
    '---------------------------
    'Rechercher les dates exclues de cette ligne
  Set oRst2 = CurrentDb.OpenRecordset("SELECT SaufDate FROM tHorValidSauf WHERE tHorLignesFK=" & Me.cboLigne & ";")
  Set oQry = CurrentDb.QueryDefs("rReservationSuppressionDatesExclues")
  Do While Not oRst2.EOF
    oQry.Parameters("DateExclue") = oRst2("SaufDate")
    oQry.Execute
    oRst2.MoveNext
  Loop
Sortie:
  Me.Section("Détail").Visible = True
  Me.Requery
  DoCmd.SetWarnings True
  oRst.Close
  Set oRst = Nothing
  On Error Resume Next
  oRst2.Close 's'il n'a pas été ouvert, une erreur 91 sera générée
  Set oRst2 = Nothing
End Sub

Commentaires du code

L'idée est de procéder par étapes pour peupler la table tUneReservation.

13 : on la vidange.

18 - 31 : pour chaque période de validité, on ajoute toutes les dates encore à venir.

Chaque date sera unique, même si en cours de processus on tente d'ajouter plusieurs fois une même date (des périodes de validité qui se chevaucheraient par exemple)

Image non disponible

33 - 45 : on supprime les dates qui correspondent aux jours non servis.

36 - 37 : on accède à la ligne de la table tHorlignes qui contient les données de la ligne en cours de traitement. Ceci pour trouver la valeur (Vrai ou Faux) affectée aux colonnes « Lundi », « Mardi », etc.

39 - 45 : on boucle sept fois sur le format d'une date quelconque (ici celle d'aujourd'hui) pour obtenir chaque jour de la semaine et sept fois exécuter la requête rReservationJoursSemSans :

Image non disponible
Image non disponible

46 - 50 : on élimine ici les dates des jours qui ne sont pas servis s'ils sont fériés

Image non disponible

en exécutant la requête rReservationJF

Image non disponible

53 - 68 : on ajoute les dates de tous les jours fériés si Image non disponible.

54 - 57 : si la case est cochée, on se crée un jeu d'enregistrements avec les périodes de validité de cette ligne.

59 - 68 : si aujourd'hui est situé à l'intérieur d'une période de validité, on ajoute les dates fériées encore à venir dans cette période :

Image non disponible

69 - 78 : reste à supprimer les dates exclues éventuelles :

Image non disponible

VI. La routine EnvoiMailRes()

 
Sélectionnez
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.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
Private Sub EnvoiMailRes()
  Dim oOutlook As Outlook.Application
  Dim oMonMessage As Object
  Dim oRST As DAO.Recordset
  Dim strobjet As String
  Dim strDestinataire As String
  Dim strMessage As String
  Dim iRet As Integer
  Dim bolOutLookOuvert As Boolean
  Dim strDetail As String
  'Tentative pour récupérer une session Outlook éventuellement déjà ouverte
  On Error Resume Next
  'S'il n'y a pas de session ouverte, l'instruction suivante va provoquer une erreur (N° 429)
  Set oOutlook = GetObject(, "Outlook.Application")
  'Traitement de l'erreur éventuelle : nous devons ouvrir une session Outlook
  If Err.Number = 429 Then
    iRet = Shell("C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE", vbHide)
    Set oOutlook = New Outlook.Application
    bolOutLookOuvert = True 'ceci pour permettre de refermer in fine Outlook que nous avons ouvert
  End If
  On Error GoTo GestionErreur
  'Construire les composantes du message
  strDestinataire = DLookup("TaxiMail", "rMailResTaxi")
  strobjet = "Réservation "
  'Construction du détail des réservations date par date
  'Recréer tMailRes et son recordset
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "rMailRes"
  DoCmd.SetWarnings True
  Set oRST = CurrentDb.OpenRecordset("tMailRes")
  oRST.MoveFirst
  Do While Not oRST.EOF
    strDetail = strDetail & oRST("ResDate") & " pour " _
            & oRST("NbrePers") & " personne(s) " & oRST("Observations") _
            & Chr(10)
    oRST.MoveNext
  Loop
  strMessage = "Bonjour," & Chr(13) & Chr(10) _
  & Chr(13) & Chr(10) _
  & "Taxi commandé : " & Chr(13) & Chr(10) _
  & DLookup("CoordTaxi", "rMailResTaxi") & Chr(13) & Chr(10) _
  & " " & Chr(13) & Chr(10) _
  & "Parcours : " & Me.cboDepart.Column(1) & " " & Format(Me.cboDepart.Column(2), "hh:mm") _
            & " => " & Me.cboDestination.Column(1) & " " & Format(Me.cboDestination.Column(2), "hh:mm") _
            & Chr(13) & Chr(10) _
  & "Circulation : " & Me.[cboLigne].Column(3) & Chr(13) & Chr(10) _
  & " " & Chr(13) & Chr(10) _
  & "Pour le client : " & Chr(13) & Chr(10) _
  & DLookup("CoordClient", "rMailResClient") & Chr(13) & Chr(10) _
  & Chr(13) & Chr(10) _
  & "Pour les dates suivantes : " & Chr(13) & Chr(10) _
  & strDetail _
  & Chr(13) & Chr(10) _
  & "Réservation enregistrée par " & Me.cboOperateur.Column(1) & Chr(13) & Chr(10) _
  & Chr(13) & Chr(10) _
  & "Bien à vous."
  'Envoi de l'e-mail
  Set oMonMessage = oOutlook.CreateItem(0) 'ouvrir une structure de message
  oMonMessage.To = strDestinataire
  oMonMessage.Subject = strobjet
  oMonMessage.Body = strMessage
  oMonMessage.Send
  Sleep 1000 'pause de 1 sec pour l'envoi
  'Libérer les variables
  Set oOutlook = Nothing
  Set oMonMessage = Nothing
  oRST.Close
  Set oRST = Nothing
  'si on a dû ouvrir une session Outlook, on la referme (sinon, on laisse la main à l'utilisateur)
  If bolOutLookOuvert = True Then KillApp (iRet)
GestionErreur:
  Select Case Err.Number
    Case 0 ' pas d'erreur
    Case Else
      MsgBox "Erreur dans EnvoiMailRes N° " & Err.Number & " " & Err.Description
  End Select
End Sub

Commentaires du code

11 -20 : ouverture d'une session Outlook (si nécessaire).

22 - 56 : construction du message.

26 - 37 : on construit la liste des réservations avec retour à la ligne après chaque item.

41 : pour les coordonnées du taxi : la requête rMailResTaxi

Image non disponible

Remarquez l'insertion de Car(13) & Car(10) dans la concaténation du texte qui provoquera un retour à la ligne.

49 : idem pour les coordonnées du client.

58 - 62 : on déclenche l'envoi du message.

63 : on temporise une seconde pour laisser le temps à Outlook.

Cette instruction nécessite que la fonction Sub Sleep soit déclarée dans un module (dans notre cas mFonctions) :

 
Sélectionnez
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

65 - 68 : on libère les variables.

70 : on referme Outlook, si nous avions dû ouvrir la session.

VII. Encoder une annulation

Image non disponible
Image non disponible
Image non disponible

VII-A. À l'ouverture du formulaire : choix du client

Seuls les clients pour lesquels une annulation est encore possible s'affichent. Contenu de la zone de liste :

Image non disponible

VII-B. Quand le client est désigné

Ses réservations encore à venir s'affichent :

 
Sélectionnez
Private Sub cboClient_AfterUpdate()
  Dim sSQL As String
  'Purge de tAnnulation
  DoCmd.SetWarnings False
  DoCmd.RunSQL " Delete * From tAnnulation;"
  'Créer la table des annulations possibles
  DoCmd.OpenQuery "rCreatAnnulation"
  DoCmd.SetWarnings True
  'Afficher
  Me.EtiCochez.Visible = True
  Me.EtiDepuis.Visible = True
  Me.Section("Détail").Visible = True
  Me.Requery
End Sub

VII-C. Comptabilisation de l'annulation

 
Sélectionnez
Private Sub BtEnregistrer_Click()
  Me.Refresh
  'Vérif présence opérateur
  If IsNull(Me.cboOperateur) Then
      MsgBox "Quel opérateur ?"
      Me.cboOperateur.SetFocus
      Me.cboOperateur.Dropdown
      Exit Sub
  End If
  'Vérif au moins une annulation
  If DCount("*", "tAnnulation", "Annul = true") = 0 Then
      MsgBox "Vous n'avez coché aucun poste !"
      Exit Sub
  End If
  'Envoyer le mail d'annulation
  Call EnvoiMailAnnul
  'Enregistrer dans tReservations
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "rAnnulation"
  DoCmd.SetWarnings True
  'Fermer le formulaire
  DoCmd.Close acForm, Me.Name
End Sub

VII-D. La routine EnvoiMailAnnul()

 
Sélectionnez
Private Sub EnvoiMailAnnul()
  Dim objOutlook As Outlook.Application
  Dim objMonMessage As Object
  Dim objRST As DAO.Recordset
  Dim strobjet As String
  Dim strDestinataire As String
  Dim strMessage As String
  Dim iRet As Integer
  Dim bolOutLookOuvert As Boolean
  Dim strDetail As String
  'Tentative pour récupérer une session Outlook éventuellement déjà ouverte
  On Error Resume Next
  'S'il n'y a pas de session ouverte, l'instruction suivante va provoquer une erreur (N° 429)
  Set objOutlook = GetObject(, "Outlook.Application")
  'Traitement de l'erreur éventuelle : nous devons ouvrir une session Outlook
  If Err.Number = 429 Then
    iRet = Shell("C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE", vbHide)
    Set objOutlook = New Outlook.Application
    bolOutLookOuvert = True 'ceci pour permettre de refermer in fine Outlook que nous avons ouvert
  End If
  On Error GoTo GestionErreur
  'Recréer tMailAnnul
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "rMailAnnul"
  DoCmd.SetWarnings True
  'Construire les composantes du message
  Set objRST = CurrentDb.OpenRecordset("tMailAnnul")
  objRST.MoveFirst
  Do While Not objRST.EOF
    strDestinataire = objRST("TaxiMail")
    strobjet = "Annulation de réservation(s) "
    strDetail = objRST("ResDate") & " pour " & objRST("NbrePers") & " personne(s) " & objRST("Observations") & Chr(10) & Chr(13)
    strMessage = "Bonjour," & Chr(13) & Chr(10) _
     & " " & Chr(13) & Chr(10) _
     & "Taxi commandé : " & Chr(13) & Chr(10) _
     & objRST("Taxi") & Chr(13) & Chr(10) _
     & " " & Chr(13) & Chr(10) _
     & "Parcours : " & objRST("Depart") & " => " & objRST("Destination") & Chr(13) & Chr(10) _
     & " " & Chr(13) & Chr(10) _
     & "Circulation : " & objRST("NumCircul") & Chr(13) & Chr(10) _
     & " " & Chr(13) & Chr(10) _
     & "Pour le client : " & Chr(13) & Chr(10) _
     & objRST("Client") & Chr(13) & Chr(10) _
     & " " & Chr(13) & Chr(10) _
     & strDetail _
     & "Annulation enregistrée par " & objRST("Operateur") & Chr(13) & Chr(10) _
     & Chr(13) & Chr(10) _
     & "Bien à vous."
    'Envoi de l'e-mail
    Set objMonMessage = objOutlook.CreateItem(0) 'ouvrir une structure de message
    objMonMessage.To = strDestinataire
    objMonMessage.Subject = strobjet
    objMonMessage.Body = strMessage
    objMonMessage.Send
    Sleep 1000 'pause de 1 sec pour l'envoi
    objRST.MoveNext
  Loop
  'Libérer les variables
  Set objOutlook = Nothing
  Set objMonMessage = Nothing
  'si on a dû ouvrir une session Outlook, on la referme (sinon, on laisse la main à l'utilisateur)
  If bolOutLookOuvert = True Then
      KillApp (iRet)
  End If
GestionErreur:
  Select Case Err.Number
    Case 0 ' pas d'erreur
    Case Else
      MsgBox "Erreur dans EnvoiMailAnnul N° " & Err.Number & " " & Err.Description
  End Select
  
End Sub

Ce code est calqué sur celui de la sous-routine EnvoiMailRes() décrite plus haut.

VIII. Vérifier la facturation

Ce qui est utile pour vérifier la facturation reçue des taxis se limite à une liste des réservations non annulées, en permettant le choix :

- de la compagnie de taxis ;

- du type de tarif (Jour : départ entre 7 et 19 heures ; Nuit sinon) ;

- d'une période.

Une procédure en deux temps :

  • un formulaire avec recherche multicritère pour cibler les courses ;
  • un état pour structurer la sélection.

VIII-A. Le formulaire fVerif

C'est un formulaire avec recherche multicritère.

VIII-A-1. À l'ouverture

Image non disponible

VIII-A-2. Après ciblage

Image non disponible

VIII-A-3. La source : rVerif

 
Sélectionnez
SELECT tTaxis.taxiNom, IIf(Format([ArretHeure],"hh")<"07","Nuit",IIf(Format([ArretHeure],"hh")>"19","Nuit",IIf([ResDate]=[DateFeriee],"Nuit",IIf(Weekday([ResDate])=1,"Nuit","Jour")))) AS Mode, [LigneNom] & "/" & [NumCirculation] AS Circulation, tReservations.ResDate, tClients.ClientNom, tReservations.NbrePers, tReservations.Observations, tJoursFeries.dateFeriee, tReservations.tHorLignesFK, tLignes.LigneNom, tHorLignes.NumCirculation, tHorArrets.ArretHeure
FROM tTaxis INNER JOIN (tLignes INNER JOIN ((tClients INNER JOIN ((tReservations INNER JOIN tHorLignes ON tReservations.tHorLignesFK = tHorLignes.tHorLignesPK) LEFT JOIN tJoursFeries ON tReservations.ResDate = tJoursFeries.dateFeriee) ON tClients.tClientsPK = tReservations.tClientsFK) INNER JOIN tHorArrets ON tHorLignes.tHorLignesPK = tHorArrets.tHorLignesFK) ON tLignes.tLignesPK = tHorLignes.tLignesFK) ON tTaxis.tTaxisPK = tHorLignes.tTaxisFK
WHERE (((tTaxis.taxiNom) Like "*" & [Formulaires]![fVerif]![FiltreTaxi] & "*") AND ((IIf(Format([ArretHeure],"hh")<"07","Nuit",IIf(Format([ArretHeure],"hh")>"19","Nuit",IIf([ResDate]=[DateFeriee],"Nuit",IIf(Weekday([ResDate])=1,"Nuit","Jour"))))) Like "*" & [Formulaires]![fVerif]![FiltreMode] & "*") AND ((tReservations.ResDate)>=IIf(IsNull([Formulaires]![fVerif]![FiltreDu]),#1/1/1900#,[Formulaires]![fVerif]![FiltreDu]) And (tReservations.ResDate)<=IIf(IsNull([Formulaires]![fVerif]![FiltreAu]),#1/1/2100#,[Formulaires]![fVerif]![FiltreAu])) AND ((tReservations.AnnulDate) Is Null) AND ((tHorArrets.Sequence)=1))
ORDER BY tTaxis.taxiNom, IIf(Format([ArretHeure],"hh")<"07","Nuit",IIf(Format([ArretHeure],"hh")>"19","Nuit",IIf([ResDate]=[DateFeriee],"Nuit",IIf(Weekday([ResDate])=1,"Nuit","Jour")))), [LigneNom] & "/" & [NumCirculation], tReservations.ResDate, tClients.ClientNom;
Image non disponible
  1. Si la technique du formulaire avec recherche multicritère ne vous est pas familière, consultez ce tutoriel : Formulaire de recherche polyvalent sur la base d'une requête enregistrée.

VIII-B. L'état eVerif

Image non disponible

VIII-B-1. La source

C'est la même que celle du formulaire au moment du clic sur le bouton Image non disponible.

VIII-B-2. Quelques caractéristiques

Image non disponible
Image non disponible

IX. Téléchargement

L'application au format Access2000 peut être téléchargée à cette adresse.

X. Remerciements

Merci à jbachet qui m'a expliqué en détail les aspects métier dans cette discussion.

Merci à jlliagre pour ses remarques.

Merci à f-leb pour la correction orthographique.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2016 Claude Leloup. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.