I. Prérequis▲
Ce tutoriel s'adresse à des utilisateurs qui maitrisent déjà les bases du logiciel Access.
Pour vérifier votre niveau, parcourez ces tutoriels : si vous les comprenez facilement, vous êtes OK et si ce n'est pas le cas, insistez :
- pour commencer : Maxence Hubiche Access - Les Bases ;
- pour construire des requêtes : Jean Ballat Créer des requêtes simples ;
- pour construire un formulaire :Jean-Philippe Ambrosino le chapitre 2-1-2 de Mise en surbrillance d'un enregistrement dans un formulaire ;
- pour le VBA : Olivier Lebeau Initiation au VBA Office.
II. Quelles sont les données à gérer ?▲
II-A. Les acteurs intervenant dans l'association▲
- Leurs coordonnées classiques : identité, adresse (pour leur faire suivre l'attestation fiscale, envoyer de l'info…).
- Leur rôle : donateur, parrain, administrateur… (pour leur envoyer des infos ciblées).
- Leurs engagements (quoi, depuis quand, jusqu'à quand).
Pour donner une idée :
II-B. Les flux financiers▲
- D'où vient l'argent : qui a donné ? Quand ? Et pour quoi faire ? (Cotisations, parrainage, marchés de Noël, soirées spaghetti…)
- Ce qu'on a fait de l'argent collecté : quand ? Pour quel objet ? (Aide aux démunis, frais de fonctionnement divers…)
Pour donner une idée :
III. Des formulaires pour peupler les tables▲
III-A. fContacts▲
- Dans un premier temps avec comme source tContacts
- Parallèlement, un formulaire sfEngt avec comme source tEngts
- On glisse et dépose le second dans le premier
et comme les tables sont liées entre elles, on obtient un formulaire père/fils
Si cette technique ne vous est pas familière, voyez ce tutoriel Comment classer les données dans des tables liées et construire un formulaire père/fils
Et nous obtenons ceci :
N.B. L'image anticipe un peu : le sous-formulaire fils sfDonContact sera ajouté plus tard en usant de la même technique.
III-B. fBanque et fCaisse▲
L'idée est de concevoir des formulaires :
- qui permettent de saisir les entrées et sorties de fonds en les classant par nature (cotisations reçues, octrois d'aide financière, frais de fonctionnement…) comme dans une comptabilité en partie double ;
- qui incluent un système d'autocontrôle. Par exemple, si le formulaire fbanque restitue le cumul des entrées et sorties qui y sont enregistrées et que cette somme correspond au solde renseigné à l'extrait délivré par la banque, il y a de fortes chances que l'encodage soit complet.
De même pour les espèces en caisse
III-C. Quelques commentaires techniques▲
III-C-1. Les images ne sont pas dans la base de données▲
Elles sont logées dans un sous-répertoire IMAGES.
À l'ouverture du formulaire, ce code
Private Sub Form_Open(Cancel As Integer)
Call AmnImages
End SubLa routine appelée est logée dans le module mImages.
Le principe est le suivant :
- le contrôle image a cette structure
- à l'ouverture du formulaire (ou de l'état), la routine AmnImages repère tous les contrôles de type image dans le formulaire et adapte leur propriété Image (Picture) en modifiant le chemin de l'image à afficher
For Each Ctrl In CodeContextObject.Controls
If Ctrl.Picture = "(aucune)" And Ctrl.PictureType = 1 And Ctrl.Tag Like "*.*" Then
Ctrl.Picture = CurrentProject.Path & "\Images\" & Ctrl.Tag
End If
Next CtrlVous trouverez plus de détails sur cette routine dans cet autre tutoriel : Stockez les images statiques de vos formulaires et états Access hors de la base de données.
III-C-2. Se positionner sur un enregistrement précis▲
Quand l'utilisateur a choisi un contact dans la liste, le contrôle cboNomPrenom contient la clé de ce contact tContactsPK
Pour se positionner sur l'enregistrement choisi, remettre la zone de liste modifiable à Null et donner le focus sur le nom et prénom :
Private Sub cboNomPrenom_AfterUpdate()
DoCmd.GoToControl "txttContactsPK"
DoCmd.FindRecord Me.cboNomPrenom
Me.cboNomPrenom = Null
Me.txtContactNom.SetFocus
End SubIII-C-3. La hauteur des sous-formulaires s'adapte suivant le nombre d'enregistrements▲
Ceci pour que la ligne « Total » colle à la dernière ligne du détail.
En bref, la hauteur du conteneur dépend du nombre enregistrements du formulaire fils. On place dans le formulaire « père » une limite au-delà de laquelle on veut stopper la progression. Une barre de défilement verticale se met alors en place.
Le processus d'adaptation est déclenché à chaque affichage d'un enregistrement du père
Private Sub Form_Current()
'Moduler la taille des sous-formulaires
Call AmenagerTailleSF(Me.Name, "CTNRsfDonsC")
Call AmenagerTailleSF(Me.Name, "CTNRsfAutresRecettesC")
Call AmenagerTailleSF(Me.Name, "CTNRsfFraisC")
Me.txtCaiDate.SetFocus
End Subet à chaque ajout ou suppression d'un enregistrement dans le fils
Private Sub Form_AfterDelConfirm(Status As Integer)
Call AmenagerTailleSF(Me.Parent.Name, Me.Parent.ActiveControl.Name)
Me.Requery
End Sub
Private Sub Form_AfterInsert()
Call AmenagerTailleSF(Me.Parent.Name, Me.Parent.ActiveControl.Name)
Me.Requery
End SubLa procédure AmenagerTailleSF() est logée dans le module mTailleSF.
Un commentaire détaillé de ce code peut être consulté dans ce tutoriel.
IV. Confection des attestations▲
IV-A. Le défi▲
En un clic sur un bouton, les attestations fiscales de l'année sont confectionnées,
- sur papier pour chaque donateur sans adresse e-mail ;
- sous forme d'un PDF, joint à un mail pour les autres.
Nous allons piloter un publipostage Word depuis Access.
IV-B. Le modèle de base▲
Voici comment il se présentera :
Si la technique ne vous est pas familière, voyez une description dans ce tutoriel.
Nous devons donc construire une table qui contiendra pour chaque donateur :
| Nom de la colonne | Contenu |
 Donateur |
4 lignes Civilité, prénom, nom Adresse Complément d'adresse éventuel Code postal, localité |
 Annee |
L'année des dons |
 NumOrdre |
Une numérotation continue |
 Total |
Le total des dons |
 Detail |
Pour chaque don La date, le mode, le montant |
IV-C. Un petit clic, mais un paquet de code▲
IV-D. Construction d'une table tProvisoire pour le publipostage ▲
IV-D-1. La requête rCreatProvisoire▲
SELECT DISTINCT CLng([tContactsFK]) AS ContactsFK, [CiviliteCourte] & " " & [ContactNom] & " " & [ContactPrenom] & Chr(13) & Chr(10) & [Adresse1] & Chr(13) & Chr(10) & [Adresse2] & Chr(13) & Chr(10) & [CodePost] & " " & [Ville] AS Donateur, Format([DonDate],"yyyy") AS Annee, DLookUp("Dons","rDonsAnnee","tContactsFK =" & [ContactsFK] & " AND Annee=" & [Annee]) AS Total, DetailDons([tContacts].[tContactsPK],[Annee]) AS Detail INTO tProvisoire
FROM tCivilites INNER JOIN (rdonContact INNER JOIN tContacts ON rdonContact.tContactsFK = tContacts.tContactsPK) ON tCivilites.tCivilitesPK = tContacts.tCivilitesFK
WHERE (((Format([DonDate],"yyyy"))=[Quelle année ? (aaaa)]) AND ((tContacts.tPaysFK)=1));
Cette transformation en Long pour éviter que la colonne créée soit NuméroAuto.
& Car(13) & Car(10) provoque un saut à la ligne lors de l'impression.
La fonction Detail()
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Public Function DetailDons(tContactsPK As Long, Annee As Integer) As String
Dim sSql As String
Dim rs As Recordset
sSql = "SELECT rdonContact.tContactsFK, Format([DonDate],""yyyy"") AS Annee, " _
& "rdonContact.DonDate, tDonModes.DonMode, rdonContact.DonMt " _
& "FROM rdonContact INNER JOIN tDonModes " _
& "ON rdonContact.tDonModesFK = tDonModes.tDonModesPK " _
& "WHERE tContactsFK =" & tContactsPK & " And Format([DonDate], ""yyyy"") =" & Annee _
& " ORDER BY rdonContact.DonDate;"
Set rs = CurrentDb.OpenRecordset(sSql)
Do Until rs.EOF
DetailDons = DetailDons & rs("DonDate") & " " & rs("DonMode") & " : " & Format(rs("DonMt"), "#.00") & " "
rs.MoveNext
Loop
End Function
Explication du code
1-2 : la définition d'une variable de type Recordset implique d'ajouter la bibliothèque Microsoft DAO x.x Object Library au projet
4-9 : on construit le SQL d'une requête qui aurait cet aspect si on appelait la fonction comme ceci DetailDons(1,2014)
donc une requête qui ramène tous les dons reçus de la part du donateur 1 pour l'année 2014.
10 : on crée un jeu d'enregistrements (recordset) avec ce SQL.
11-14 : on lit un à un les enregistrements et pour chacun (12), on concatène la date, le mode et le montant.
En l'occurrence, la fonction donnerait ceci :
IV-D-2. On ajoute une colonne NuméroAuto à la table tProvisoire▲
Avec ce code
DoCmd.RunSQL "ALTER TABLE tProvisoire ADD COLUMN NumOrdre COUNTER"IV-D-3. À ce stade, voici à quoi ressemble tProvisoire▲
IV-E. Une procédure pour publiposter les lettres qui seront mises sous pli▲
IV-E-1. Les étapes▲
IV-E-2. Le code▲
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.
Public Sub PubliPapier(Genre As String)
Dim objWord As Word.Application
Dim NomDoc As String
Dim ModeleDoc As String
Dim SavedDoc As String
'Ajuster les paramètres en fonction du Genre
'-------------------------------------------
Select Case Genre
Case "Attestations"
ModeleDoc = CurrentProject.Path & "\ATTESTATIONS\AttestationsModele.doc"
SavedDoc = CurrentProject.Path & "\AEnvoyer\AttestationsAEnvoyer.doc"
'Créer la table tPubliPapier
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT tProvisoire.*, tContacts.Courriel1 INTO tPubliPapier " _
& "FROM tContacts INNER JOIN tProvisoire " _
& "ON tContacts.tContactsPK = tProvisoire.ContactsFK " _
& "WHERE tContacts.Courriel1 Is Null;"
DoCmd.SetWarnings True
Case "ArchivAttest"
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT tProvisoire.*, tContacts.Courriel1 INTO tPublipapier " _
& "FROM tContacts INNER JOIN tProvisoire " _
& "ON tContacts.tContactsPK = tProvisoire.ContactsFK;"
DoCmd.SetWarnings True
ModeleDoc = CurrentProject.Path & "\ATTESTATIONS\AttestationsModele.doc"
SavedDoc = CurrentProject.Path & "\ATTESTATIONS\Archives\" _
& DLookup("Annee", "tPubliPapier") & "ArchivageAttestations.doc"
Case "Courrier"
ModeleDoc = Forms!fEnvoiCourrier!txtCheminDoc
SavedDoc = CurrentProject.Path & "\AEnvoyer\CourrierAEnvoyer.doc"
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT * INTO tPubliPapier " _
& "FROM tCourrier WHERE tCourrier.Poste=True;"
DoCmd.SetWarnings True
End Select
'Publiposter
'-----------
Set objWord = New Word.Application
With objWord
' Ouvrir le document modèle
.Documents.Open ModeleDoc
.ActiveDocument.MailMerge.OpenDataSource _
Name:=CurrentDb.Name, SQLStatement:="SELECT * FROM [tPubliPapier]"
.ActiveDocument.MailMerge.Execute
.ActiveDocument.SaveAs2 SavedDoc
.Documents.Close
End With
' Fermer et libérer les objets
'-----------------------------
objWord.Quit
Set objWord = Nothing
'Supprimer la table tPubliPapier
'-------------------------------
DoCmd.DeleteObject acTable, "tPubliPapier"
'Montrer le résultat du publipostage
'-----------------------------------
Shell "C:\WINDOWS\EXPLORER.EXE " & SavedDoc
End Sub
Commentaire du code
1 : cette routine contient un paramètre qui renseigne le genre de document à publiposter.
Ici, il s'agira de « Attestations », d'autres cas seront évoqués plus loin ici et ici).
2-5 : on définit des variables, dont Dim objWord As Word.Application qui implique que l'on ajoute la bibliothèque Microsoft Word xx.x Object Library au projet (« xx.x » correspond à la version installée sur votre machine)
10-41 : on ajuste le contenu de certaines variables en fonction du paramètre.
13 : dans notre cas, le document modèle décrit plus haut a été logé dans le sous-répertoire « ATTESTATIONS » et s'appelle « AttestationsModele.doc ».
14 : le document issu du publipostage sera logé dans le sous-répertoire « AEnvoyer » et s'appellera « AttestationsAEnvoyer.doc ».
17-20 : on crée une table tPubliPapier, le SQL correspond à cette requête :
En clair, on prend dans tProvisoire tous les contacts qui n'ont pas d'adresse e-mail.
22-41 : ces instructions concernent d'autres valeurs du paramètre.
43-54 : le publipostage proprement dit :
45 : on interface Access avec Word ;
48-53 : on déclenche la procédure de publipostage dans Word, avec le document ModeleDoc et on loge le résultat à l'adresse SavedDoc.
58-59 : on referme Word et on libère la mémoire.
63 : on supprime la table tPubliPapier désormais inutile.
67 : on ouvre le document à publiposter : l'utilisateur n'a plus qu'à l'imprimer et à le mettre sous enveloppe.
Remarquez cette syntaxe « passe-partout »
Shell "C:\WINDOWS\EXPLORER.EXE " & LeCheminDunFichier
Cela correspond à un double-clic sur le fichier quand vous êtes dans Explorer : le fichier s'ouvre avec le programme qui lui est associé.
IV-F. Une procédure pour publiposter des lettres qui seront envoyées par e-mail▲
Pour utiliser le code suivant, vous devez disposer de PDFCreator, c'est un programme gratuit qui vous permet d'installer une imprimante qui, au lieu de produire du papier, crée un fichier .pdf.
Chercher sur internet un endroit pour le télécharger.
Voici les paramètres qui ont été choisis pour l'installation : l'enregistrement automatique dans le répertoire C:\PDF\(1)
Menu Imprimante > Options > Enregistrement automatique
IV-F-1. Les étapes▲
Préparer le terrain
Boucler pour publiposter un à un et envoyer par e-mail
Faire le ménage avant de partir
IV-F-2. Le code▲
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.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
Public Sub PubliMail(Genre As String)
Dim objOutlook As Outlook.Application
Dim MonMessage As Object
Dim wsn As Object
Dim rst As Recordset
Dim sImprDefaut As String
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Folder
Dim oFl As File
Dim objWord As Word.Application
Dim NomDoc As String
Dim ModeleDoc As String
Dim NomPDF As String
Dim ObjetMail As String
Dim MessageMail As String
'Assigner l'objet Outlook et Word
Set objOutlook = New Outlook.Application
Set objWord = New Word.Application
'Changer l'imprimante par défaut
'-------------------------------
'Mémoriser l'imprimante par défaut
sImprDefaut = ImprimanteParDefaut()
'PDFCreator comme imprimante par défaut
Set wsn = CreateObject("WScript.Network")
wsn.SetDefaultPrinter "PDFCreator"
'Ajuster les paramètres en fonction du Genre
'-------------------------------------------
Select Case Genre
Case "Attestations"
ModeleDoc = CurrentProject.Path & "\ATTESTATIONS\AttestationsModele.doc"
NomPDF = "Attestation.pdf"
ObjetMail = "Votre attestation fiscale"
MessageMail = "Merci encore."
'Créer la table tPubliMail
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT tProvisoire.*, tContacts.Courriel1 INTO tPubliMail " _
& "FROM tContacts INNER JOIN tProvisoire " _
& "ON tContacts.tContactsPK = tProvisoire.ContactsFK " _
& "WHERE Not tContacts.Courriel1 Is Null;"
DoCmd.SetWarnings True
Case "Courrier"
ModeleDoc = Forms!fEnvoiCourrier!txtCheminDoc
NomPDF = "Courrier.pdf"
ObjetMail = Forms!fEnvoiCourrier!txtObjet
MessageMail = Forms!fEnvoiCourrier!txtMessMail
'Créer la table tPubliMail
DoCmd.SetWarnings False
DoCmd.RunSQL "SELECT * INTO tPubliMail FROM tCourrier WHERE tCourrier.[e-Mail]=True;"
DoCmd.SetWarnings True
End Select
'Lire chaque enregistrement de tPubliMail
'----------------------------------------
Set rst = CurrentDb.OpenRecordset("tPubliMail")
Do Until rst.EOF
'Créer tPubliUnMail => avec l'enregistrement en cours de tPubliMail
DoCmd.SetWarnings False
Select Case Genre
Case "Attestations"
DoCmd.RunSQL "SELECT * INTO tPubliUnMail " _
& "FROM tPubliMail WHERE ContactsFK=" & rst("ContactsFK") & ";"
Case "Courrier"
DoCmd.RunSQL "SELECT * INTO tPubliUnMail " _
& "FROM tPubliMail WHERE NomPrenom=""" & rst("NomPrenom") & """;"
End Select
DoCmd.SetWarnings True
'Créer le PDF de cette attestation
'---------------------------------
'S'assurer que c:/pdf est vide
Set oFSO = New Scripting.FileSystemObject
Set oFld = oFSO.GetFolder("c:\pdf")
For Each oFl In oFld.Files
oFl.Delete
Next oFl
'Publiposter
'-----------
With objWord
.Visible = True
' Ouvrir le document type
.Documents.Open ModeleDoc
.ActiveDocument.MailMerge.OpenDataSource _
Name:=CurrentDb.Name, SQLStatement:="SELECT * FROM [tPubliUnMail]"
.ActiveDocument.MailMerge.Execute
.ActiveDocument.PrintOut
.Documents.Close SaveChanges:=wdDoNotSaveChanges
End With
Sleep 2000 'pause de 2 s pour créer le document
'Renommer le fichier PDF
'-----------------------
For Each oFl In oFld.Files
oFl.Name = NomPDF
Next
'Expédier le mail avec le PDF en pièce jointe
'--------------------------------------------
'Composer le message
Set MonMessage = objOutlook.createitem(0) 'ouvrir une structure de message
MonMessage.To = rst("Courriel1")
MonMessage.Subject = ObjetMail
MonMessage.Body = MessageMail
MonMessage.Attachments.Add "c:\pdf\" & NomPDF
MonMessage.send
Sleep 2000 'pause de 2 s pour l'envoi
'Au suivant...
rst.MoveNext
Loop
Sortie:
'Rétablir l'imprimante par défaut
wsn.SetDefaultPrinter sImprDefaut
Set wsn = Nothing
'Fermer Outlook et Word
objOutlook.Quit
Set objOutlook = Nothing
objWord.Quit
Set objWord = Nothing
'Libérer le recordset
rst.Close
Set rst = Nothing
'Supprimer les tables temporaires
DoCmd.DeleteObject acTable, "tPubliMail"
DoCmd.DeleteObject acTable, "tPubliUnMail"
End Sub
Commentaire du code
Cette routine contient un paramètre qui renseigne le genre de document à publiposter.
Ici, il s'agira de « Attestations », d'autres cas seront évoqués plus loin (ici et ici).
2-15 : on définit des variables dont
- Dim objOutlook As Outlook.Application qui implique que l'on ajoute la bibliothèque Microsoft Outlook xx.x au projet (« xx.x » correspond à la version installée sur votre machine) ;
- Dim oFSO As Scripting.FileSystemObject, Dim oFld As Folder et Dim oFl As File qui impliquent Microsoft Scripting Runtime.
22-27 : on mémorise les coordonnées de l'imprimante actuellement par défaut (pour pouvoir la rétablir in fine) et on installe PDFCreator à la place.
24 : la fonction ImprimanteParDefaut() se trouve dans le module mDivers. (Désolé pour le manque d'explication, c'est un copier-coller de quelque part. Je n'ai pas tout compris, mais ça marche !)
40-43 : on crée une table tPubliMail qui contient tous les contacts à qui envoyer une attestation par e-mail. Le SQL généré correspond à ceci :
65-66 : dans la boucle de lecture des enregistrements de tPubliMail, on crée une table tPubliUnMail qui ne contient que le seul enregistrement en cours de lecture.
75-80 : on vidange le répertoire c:\pdf. Ce sera plus simple pour rebaptiser le fichier PDF que nous allons créer par publipostage.
Il est donc impératif que le répertoire choisi pour loger les PDF générés par PDFCreator (dans l'exemple : c:\pdf) ne contienne aucun fichier que vous voudriez garder !
91 : le résultat du publipostage sera logé dans le répertoire c:\pdf et portera le nom que PDFCreator lui aura automatiquement donné. Quelque chose comme ceci :
94 : on fait une pause de deux secondes pour laisser le temps à Word de s'exécuter. En effet Access fonctionne de manière asynchrone, c'est-à-dire que dans le code une instruction n'attend pas que la précédente soit terminée. En l'occurrence, les instructions 98-100 qui vont rebaptiser le fichier PDF pourraient s'exécuter avant que le fichier PDF ne soit créé ! Ceci lèverait ce message d'erreur
Le délai nécessaire (ici 2 s) dépend de la vitesse de votre machine. Ajustez si nécessaire toutes les occurrences de Sleep dans tout le code du projet
98-100 : on rebaptise le fichier .pdf en lui donnant le nom « Attestation.pdf » (attribué à la variable NomPDF à l'instruction 35.
106-112 : on construit l'e-mail et on l'expédie avec Attestation.pdf en pièce jointe.
La suite du code n'appelle pas davantage de commentaires.
V. Archivage des attestations fiscales▲
Une copie des attestations doit être sauvegardée en vue d'un éventuel contrôle du fisc.
La procédure est une variante de ce que nous venons de décrire au chapitre précédent.
Nous publipostons sur papier pour l'ensemble des contacts concernés (qu'ils aient ou non une adresse e-mail) :
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Private Sub btArchiAttest_Click()
'Créer tProvisoire
DoCmd.SetWarnings False
DoCmd.OpenQuery "rCreatProvisoire"
DoCmd.RunSQL "ALTER TABLE tProvisoire ADD COLUMN NumOrdre COUNTER"
DoCmd.SetWarnings True
'Créer le document à archiver
Call PubliPapier("ArchivAttest")
'Supprimer la table tProvisoire
DoCmd.DeleteObject acTable, "tProvisoire"
End Sub
VI. Envoi de courrier ciblé▲
VI-A. Le formulaire fEnvoiCourrier▲
À l'ouverture
- Tous les types de contacts sont sélectionnés comme destinataires. (Sans doublon pour les contacts qui ont plusieurs types d'engagements.)
- Pour éliminer des types de contacts, il suffit de décocher les cases non désirées
- On peut aussi supprimer des enregistrements de manière manuelle, en les sélectionnant
et en pressant la touche <DEL> ou <Suppr>.
- Selon que le contact a donné une adresse courriel ou non, la case est cochée par défaut
(Il est possible de modifier ponctuellement la voie d'expédition pour autant qu'elle soit disponible pour ce contact.)
- Pour renseigner le chemin du document à publiposter, on peut :
- soit l'introduire manuellement ;
- soit cliquer le bouton Parcourir… qui ouvre une fenêtre de recherche de fichier.
- Cliquer le bouton OK déclenche le processus d'envoi.
VI-B. Le code▲
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.
89.
90.
91.
92.
Option Compare Database
Option Explicit
Private Sub Form_Open(Cancel As Integer)
Me.RecordSource = ""
DoCmd.SetWarnings False
DoCmd.OpenQuery "rCreaCourrier"
DoCmd.SetWarnings True
Me.RecordSource = "tCourrier"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Me.RecordSource = ""
DoCmd.DeleteObject acTable, "tCourrier"
End Sub
Private Sub BtChercher_Click()
Me.txtCheminDoc = OuvrirUnFichier(Me.hwnd, "Quel document ?", 1, , , CurrentProject.Path & "\COURRIER")
End Sub
Private Sub btOK_Click()
Dim oFSO As Scripting.FileSystemObject
Me.Refresh
'Vérifier complétude du formulaire
If IsNull(Me.txtCheminDoc) + IsNull(Me.txtMessMail) + IsNull(Me.txtObjet) <> 0 Then
MsgBox "Des champs obligatoires manquent"
Exit Sub
End If
'Vérifier la présence du modèle
Set oFSO = New Scripting.FileSystemObject
If oFSO.FileExists(Me.txtCheminDoc) = False Then
MsgBox "Le document à publiposter est introuvable", vbCritical
Me.txtCheminDoc.SetFocus
Exit Sub
End If
'Créer les lettres si demandées
If DSum("Poste", "tCourrier") <> 0 Then Call PubliPapier("Courrier")
'Créer les e-mail si demandés
If DSum("[e-mail]", "tCourrier") <> 0 Then Call PubliMail("Courrier")
End Sub
Private Sub BtTous_Click()
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.Name Like "cc*" Then
ctl = -1
End If
Next ctl
Me.Repaint
Call Form_Open(0)
End Sub
Private Sub ccAdmi_AfterUpdate()
Call Form_Open(0)
End Sub
Private Sub ccDona_AfterUpdate()
Call Form_Open(0)
End Sub
Private Sub ccParr_AfterUpdate()
Call Form_Open(0)
End Sub
Private Sub ccSymp_AfterUpdate()
Call Form_Open(0)
End Sub
Private Sub ccAdhe_AfterUpdate()
Call Form_Open(0)
End Sub
Private Sub Poste_BeforeUpdate(Cancel As Integer)
If Me.Poste = True Then
If IsNull(DLookup("Adresse1", "tCourrier", "NomPrenom=""" & Me.txtNomPrenom & """")) Then
MsgBox "Ce contact n'a pas d'adresse postale", vbCritical
Cancel = True
Me.Poste.Undo
End If
End If
End Sub
Private Sub e_Mail_BeforeUpdate(Cancel As Integer)
If Me.e_Mail = True Then
If IsNull(DLookup("Courriel1", "tCourrier", "NomPrenom=""" & Me.txtNomPrenom & """")) Then
MsgBox "Ce contact n'a pas d'adresse e-mail", vbCritical
Cancel = True
Me.e_Mail.Undo
End If
End If
End Sub
Commentaire du code
4-10 : à l'ouverture, on exécute la requête rCreaCourrier qui crée (provisoirement) une nouvelle table tCourrier.
la valeur de la colonne sera égale à -1 si le contact n'a pas d'adresse e-mail, 0 s'il en a une.
le contraire : la colonne sera égale à -1 si le contact a une adresse e-mail, 0 s'il n'en a pas.
seulement pour les tTypesEngtPK qui correspondent aux cases cochées dans le formulaire. (À l'ouverture, elles sont toutes cochées par défaut.)
La table tCourrier ainsi créée :
Cette table est affectée comme source au formulaire (instruction 9).
12-15 : la table sera supprimée lors de la fermeture du formulaire.
17-19 : un clic sur le bouton « Chercher » déclenche l'ouverture d'une boîte de dialogue pour le choix d'un fichier : 
Le https://access.developpez.com/faq/?page=CheminsRep - AffBoitDialog a été intégralement copié dans le module mBoiteDialogue.
Les paramètres de l'appel :
21-40 : lors d'un clic sur le bouton OK, on vérifie d'abord que l'utilisateur a complété les champs utiles pour publiposter.
25 : la fonction IsNull(Me.LeNomDuContrôle) renverra « 0 » ou « -1 » selon que le champ a été complété ou non. Donc IsNull(Me.txtCheminDoc) + IsNull(Me.txtMessMail) + IsNull(Me.txtObjet) différent de zéro signifie qu'au moins un champ a la valeur Null.
37-39 : pour chacune des colonnes « Par poste » et « Par e-mail », pour autant qu'il y reste une case cochée, on appelle les procédures PubliPapier ou PubliMail déjà décrites plus haut (ici et ici).
42-51 : lors d'un clic sur le bouton « Tous », on parcourt tous les contrôles du formulaire et s'il s'agit d'un des filtres (leur nom commence par « cc »), on coche la case et on redéclenche le processus prévu à l'ouverture du formulaire.
53-71 : lorsque l'état d'un des filtres est modifié, on redéclenche le processus prévu à l'ouverture du formulaire.
73-fin : avant d'accepter que l'utilisateur coche une case dans les colonnes « Par poste » et « Par email », on vérifie que le contact concerné dispose bien d'une telle adresse. Si ce n'est pas le cas, on affiche un message pour signaler le refus de l'action.
VII. Quelques états▲
VII-A. Un premier choix▲
Le formulaire fMenuListes permet de paramétrer les types de contacts concernés par l'état qui résultera du clic sur l'un des boutons.
À l'origine toutes les cases sont cochées.
Un clic sur le bouton « Tous » recoche celles que l'utilisateur aurait décochées.
Private Sub BtTous_Click()
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.Name Like "cc*" Then
ctl = -1
End If
Next ctl
End SubVII-B. Le code associé aux listes présentées ici▲
Peu de commentaire.
À l'ouverture, on aménage les adresses des images liées (même code que pour un formulaire)
Private Sub Report_Open(Cancel As Integer)
Call AmnImages
End SubDans l'événement « Sur formatage » de la section qui contient les adresses et téléphone, ce code
Private Sub Détail_Format(Cancel As Integer, FormatCount As Integer)
Me.ImageCourriel.Visible = Not IsNull(Me.txtCourriel1)
Me.ImageAdresse.Visible = Not IsNull(Me.txtAdresse1)
Me.ImageTel.Visible = (IsNull(Me.txtTelfixe1) + IsNull(Me.txtGsm1)) > -2
End Subpour cacher l'icône si elle s'avère inutile.
Lorsqu'une année intervient dans l'état (par exemple dans « Liste des dons par contact »), le code est un peu plus étoffé :
- on invite l'utilisateur à saisir une année
'Choix de l'Année
Annee = InputBox(" Introduisez l'année (AAAA)" & vbLf & "Laisser vide pour toutes les années")cette fenêtre apparaît
- on construit alors à la volée la requête source de l'état, par exemple
'Aménager la source
sSelect = "SELECT Format([DonDate],""yyyy"") AS Annee, Sum(rdonContact.DonMt) AS SommeDeDonMt, " _
& "[CiviliteCourte] & "" "" & [ContactNom] & "" "" & [ContactPrenom] AS NomPrenom, " _
& "tContacts.Adresse1, tContacts.Adresse2, tContacts.CodePost, tContacts.Ville, tPays.Pays, " _
& "tContacts.Courriel1, tContacts.Telfixe1, tContacts.Gsm1, tContacts.ContactNom, " _
& "tContacts.ContactPrenom " _
& " FROM tPays RIGHT JOIN ((tCivilites INNER JOIN (tContacts INNER JOIN rdonContact " _
& " ON tContacts.tContactsPK = rdonContact.tContactsFK) " _
& "ON tCivilites.tCivilitesPK = tContacts.tCivilitesFK) INNER JOIN tEngts " _
& "ON tContacts.tContactsPK = tEngts.tContactsFK) ON tPays.tPaysPK = tContacts.tPaysFK " _
& "WHERE (((tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccAdhe] = -1, 1, 0) " _
& "Or (tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccDona] = -1, 2, 0) " _
& "Or (tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccParr] = -1, 3, 0) " _
& "Or (tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccParr] = -1, 4, 0) " _
& "Or (tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccAdmi] = -1, 6, 0) " _
& "Or (tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccSympa] = -1, 7, 0) " _
& "Or (tEngts.tTypesEngtFK) = IIf([Formulaires]![fMenuListes]![ccCli] = -1, 8, 0))) " _
& "GROUP BY Format([DonDate],""yyyy""), [CiviliteCourte] & "" "" & [ContactNom] & "" "" & [ContactPrenom], " _
& "tContacts.Adresse1, tContacts.Adresse2, tContacts.CodePost, tContacts.Ville, " _
& "tPays.Pays, tContacts.Courriel1, tContacts.Telfixe1, tContacts.Gsm1, " _
& "tContacts.ContactNom, tContacts.ContactPrenom "
'Clause Having (dépend du choix de l'année)
If Len(Annee) = 4 Then 'L'utilisateur a choisi une année
sHaving = "HAVING Format([DonDate],""yyyy"") = """ & Annee & """ "
Else
sHaving = "HAVING Format([DonDate],""yyyy"") Like ""*"" "
End If
'Affecter la source
Me.RecordSource = sSelect & sHaving & ";"Pour visualiser la représentation graphique d'un SQL écrit dans le code, vous pouvez utiliser l'interface graphique QBE (Query by Example).
Procédez comme ceci :
- ajouter cette instruction après la confection du SQL, ici, juste avant la dernière ligne
Debug.print sSelect & sHaving & ";"
- afficher l'état pour que le code se déclenche. Vous pouvez alors copier le SQL généré dans la fenêtre d'exécution et le coller dans une requête de test.
Pour vous familiariser avec cette technique, voyez ce tutoriel Initiation - Débogage : requêtes écrites par VBA de Charles A (cafeine) et singulièrement, le chapitre V.
VIII. Deux bases : une dorsale et une frontale▲
Pour approfondir le sujet, voyez le tutoriel de Morgan Billy (Dolphy35) Comment utiliser une application en mode multiutilisateur
Les tables permanentes et leurs relations, dans la dorsale AssociationData.mdb et tout le reste (requêtes, formulaires, états, macros et code) dans la frontale AssociationSoft.mdb.
Les deux db sont logées dans le même répertoire.
Cette organisation permet de répartir la mise à jour des tables entre plusieurs utilisateurs. Par exemple l'un se charge de l'enregistrement des dons (fCaisse et fBanque) et l'autre de tout ce qui est administratif (fContacts, envoi des attestations…).
Chacun prend la main tour à tour. Quand l'un a terminé sa gestion, il envoie AssociationData.mdb via e-mail à l'autre et lui cède la main. Celui qui prend la main, remplace le fichier AssociationData.mdb qu'il avait sur son PC par celui qu'il vient de recevoir par e-mail. Il opère ses changements et recède la main. Et on est reparti pour un tour…
IX. Une arborescence particulière▲
Ceci pour faciliter la maintenance et alléger le code (utilisation de répertoires relatifs)
Les deux db, AssociationSoft.mdb et AssociationData.mdb, sont logées dans un répertoire quelconque (sur le disque dur, sur un réseau, sur une clé USB…).
Ce répertoire contient des sous-répertoires :
AENVOYER : qui recueillera le résultat du dernier publipostage à mettre sous enveloppe ;
ATTESTATIONS : contient le document modèle pour le publipostage des attestations fiscales. Son sous-répertoire Archives contiendra la copie annuelle des attestations destinée au contrôle fiscal éventuel ;
COURRIER : les différents modèles de lettres à publiposter ;
IMAGES : les images liées aux formulaires et états.
IX-A. Adaptation automatique de la liaison dorsale/frontale, si changement de localisation▲
À chaque ouverture de la base, la macro « Autoexec » se déclenche
La fonction AttacheData() est logée dans le module mAttacherTables.
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.
Option Compare Database
Option Explicit
Public Function AttacheData()
On Error GoTo GestionErreurs
Dim db As Database
Dim tdfLoop As TableDef
Dim CheminSoft As String
Dim CheminData As String
CheminSoft = CurrentDb.Name
CheminData = Left(CheminSoft, Len(CheminSoft) - 8) & "data.mdb"
'Vérifie que l'emplacement n'a pas changé depuis la fois précédente
If DLookup("Database", "MSysObjects", "not isnull(Database)") = CheminData Then Exit Function 'le répertoire n'a pas été changé
'Pour attacher les tables de data
Set db = OpenDatabase(CheminData)
For Each tdfLoop In db.TableDefs
If Left(tdfLoop.Name, 4) <> "MSys" Then
DoCmd.DeleteObject acTable, tdfLoop.Name
DoCmd.TransferDatabase acLink, "Microsoft Access", CheminData, acTable, tdfLoop.Name, tdfLoop.Name
End If
Next tdfLoop
MsgBox "L'attachement des tables a été actualisé"
db.Close
Set db = Nothing
Exit Function
GestionErreurs:
If Err.Number = 7874 Then 'la table n'est pas encore dans XXXSoft
Resume Next
Else
MsgBox "Erreur dans l'attachement des tables " & Err.Number & " " & Err.Description
End If
End Function
Explication du code
4 : AttacheData() ne renvoie pas de valeur, ce devrait donc être une Sub. On la définit néanmoins comme Function pour pouvoir la déclencher dans une macro (« AutoExec » en l'occurrence).
11 : on détermine quel devrait être le chemin de la xxxData.mdb, sachant qu'elle doit se trouver dans le même répertoire que la xxxSoft.mdb.
13 : on vérifie que ce chemin est bien celui enregistré dans la table système MsysObjects.
Pour afficher les tables système : Outils>Options…>Affichage cocher la case Objets système
La table MSysObjects contient une colonne « Database » qui renseigne l'adresse de la db qui contient chaque table liée
Si on constate que l'adresse renseignée correspond à celle « calculée » en 11, on en conclut que les db se trouvent encore au même endroit que lors de l'exécution précédente. Tout va bien, on sort.
Par contre s'il y a différence, c'est que xxxSoft.mdb a changé d'emplacement et qu'il faut donc réactualiser les liaisons.
15-21 : réactualisation des liaisons. Pour chaque table (autre que les tables système) contenue dans xxxData.mdb, on supprime la table (liée) dans xxxSoft.mdb (18) et on établit la nouvelle liaison (19).
22 : on signale que le rafraîchissement des liaisons a été effectué :
alias