Apprendre à utiliser Access pour gérer une cave à vin

On s'attend à ce que la source de fBouteilles soit la table tBouteilles.
Cela conviendrait pour un formulaire traditionnel (CRUD) qui permet de créer des enregistrements (Create), de les lire (Read), de les modifier c'est-à-dire de les mettre à jour (Update) et de les supprimer (Delete).
Nous avons voulu ici ajouter une fonctionnalité : restreindre, à la demande, le nombre des enregistrements affichés. À savoir, proposer seulement ceux qui répondent à certains critères exprimés par l'utilisateur, et cela, avec un formulaire SCRUD (Select) qui en plus, permet de sélectionner les enregistrements à afficher.

Ici les différents critères de sélection sont :

Convention de nommage les champs s'appellent : FiltrePays, FiltreCru, […] , FiltreFormat et caStock.

Voici une méthode pour fabriquer un formulaire SCRUD basé sur une requête enregistrée.

V-A-1. Première étape : construire une requête qui affiche toutes les données qui interviennent dans le formulaire et les filtres▲

Le formulaire fBouteilles doit être ouvert pour que l'on puisse faire référence à son contenu.

Nous prenons évidemment toutes les colonnes de tBouteilles, nous ajoutons une requête rStock pour disposer du stock et la table tRegions pour disposer de la région. La table tAppellations est aussi nécessaire pour permettre la liaison entre une bouteille et sa région.

V-A-2. Deuxième étape : ajouter les critères de sélection▲

Il faut dire à Access : « Si dans le formulaire la valeur du filtre est Null, alors il faut ramener tous les enregistrements. Sinon, ramener seulement ceux qui satisfont au critère contenu dans le filtre. »

V-A-2-a. Exemple pour un filtre texte à recherche étendue▲

V-A-2-b. Exemple pour un filtre à recherche stricte▲

V-A-2-c. Exemple pour un filtre du type groupe d'options▲

D'une part la requête rStock et d'autre part le groupe d'options :

Le challenge, c'est de dire à Access : « Si le groupe d'options vaut :

• 0, il faut ramener les enregistrements dont la somme des mouvements est Null ou 0 ;
• 1, il faut ramener les enregistrements dont la somme des mouvements est différente de 0 ;
• 2, il faut ramener tous les enregistrements. »

Nous n'avons pas trouvé la syntaxe pour exprimer le critère par rapport au nombre de bouteilles en stock, par exemple, dire « ramener les enregistrements avec stock <>0 si le groupe vaut 1 » (voyez cette discussion sur le forum à ce sujet).
C'est pour contourner cet obstacle que nous avons ajouté une colonne booléenne « OuiSiVide » à la requête rStock et nous testons ainsi :

V-A-3. Troisième étape : affecter cette requête comme source du formulaire▲

Habituellement, il suffit de renseigner la requête que l'on vient de construire comme source du formulaire :

Ici, une petite difficulté supplémentaire : le résultat de la requête n'est plus modifiable à cause de la requête rStock qui intervient dans le modèle :

La requête rfBouteilles ne peut pas être la source du formulaire fBouteilles sous peine qu'il devienne impossible de créer un nouvel enregistrement, impossible de modifier une donnée et impossible de supprimer un enregistrement :

Pour contourner le problème, nous allons ruser : au lieu de prendre rfBouteilles comme source, nous allons prendre une requête qui ramène tous les enregistrements de tBouteilles qui sont sélectionnés par rfBouteilles, c'est-à-dire ceux qui sont ramenés par :

Et comme source du formulaire, nous prendrons :

V-A-4. Le code VBA associé au fonctionnement des filtres▲

Private Sub FiltrePays_AfterUpdate()
  Me.Requery
End Sub

Private Sub FiltrePays_DblClick(Cancel As Integer)
  Me.ActiveControl = Null
  Me.Requery
End Sub

Private Sub BtTout_Click()
  Dim oCtl As Control
  'Réinitialiser les filtres standard
  For Each oCtl In Me.Controls
    If oCtl.Name Like "Filtre*" Then
        oCtl = Null
    End If
  Next oCtl
  'Réinitialiser caStock
  Me.caStock = 2
  'Réactualiser la sélection
  Me.Requery
End Sub

Ou signaler son absence éventuelle.

Access permet de stocker des images directement dans la base de données. Que ce soit en tant que valeur du champ OLE d'une table ou en tant que propriété Image (Picture) d'un formulaire, d'un état ou d'un contrôle de l'un de ces deux objets. Toutefois, cela peut très vite alourdir la base de données si l'on a un grand nombre d'images en jeu.

cafeine, dans son tutoriel Gestion de photos par formulaire, a montré comment externaliser les images : il propose de stocker les adresses dans une table au lieu des images elles-mêmes.

Ici, nous allons un pas plus loin. Pas de table avec les adresses, mais une convention : les images seront toutes logées dans un sous-répertoire « Images » de l'application. Ainsi, quel que soit l'endroit où vous avez installé la base de données, le chemin complet de la photo sera CurrentProject.Path & "/Images/" & LeNomDeLaPhoto.

Et pour simplifier encore : on conviendra que le nom de la photo se compose de la clé de l'enregistrement avec l'extension « .jpg ».

S'il s'avère que le fichier est absent, on affiche par défaut Default.jpg

Voici le code VBA associé à l'événement « Sur Activation » du formulaire, il se déclenche à chaque lecture d'un enregistrement :

'Afficher l'image
  If existeFileFSO(CurrentProject.Path & "/Images/" & Me.txttBouteillesPK & ".jpg") Then
      Me.Image.Picture = CurrentProject.Path & "/Images/" & Me.txttBouteillesPK & ".jpg"
    Else
      Me.Image.Picture = CurrentProject.Path & "/Images/Default.jpg"
  End If

L'idée consiste à ouvrir une boîte de dialogue pour rechercher une image .jpg, quel que soit son nom actuel, pour en stocker une copie rebaptisée dans le sous-répertoire Images.

Voici le code associé au clic du bouton :

Private Sub BtAjouterImage_Click()
  Dim sOriginal As String
  On Error GoTo GestionErreurs
  Me.Refresh
  sOriginal = ChoisirUnFichier(Me.hwnd, "Quelle image .jpg voulez-vous affecter ?", 1, "Fichiers *.jpg", "jpg", "c:\")
  'Affecter l'image à l'enregistrement en cours
  FileCopy sOriginal, CurrentProject.Path & "/Images/" & Me.txttBouteillesPK & ".jpg"
  Me.Image.Picture = CurrentProject.Path & "/Images/" & Me.txttBouteillesPK & ".jpg"
GestionErreurs:
  Select Case Err.Number
    Case 0 'pas d'erreur
      Exit Sub
    Case 75 'aucun fichier n'a été choisi
      Exit Sub
    Case Else
      MsgBox "Erreur dans BtAjouterImage_Click N° " & Err.Number & " " & Err.Description
  End Select
End Sub

N.B. Le code de la routine ChoisirUnFichier se trouve dans le module mArkham46.

Il s'agit d'une version améliorée par Arkham46 pour la rendre compatible 32 bits/64 bits.

Loufab a proposé une routine qui permet d'ouvrir un fichier avec le programme que l'utilisateur a associé à l'extension du fichier.

Il suffit de loger dans un module le code suivant :

Option Compare Database
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal Hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Public Sub Ouvrir_fichier(Chemin As String)
 
'Ouvrir, avec le pgm associé, le fichier dont le chemin est passé en paramètre
ShellExecute Application.hWndAccessApp, "open", Chemin, "", "", 1
 
End Sub

On écrit Ouvrir_fichier(LeCheminDeCeFichier) et tout se passe comme si vous aviez double-cliqué sur le nom du fichier dans votre explorateur de fichiers.

Cette routine fonctionne aussi avec une URL, ainsi, Ouvrir_fichier ("http://www.google.com/") va entraîner l'affichage de la page d'accueil de Google par votre navigateur.

Et si vous voulez lancer directement une recherche, la syntaxe est
Ouvrir_fichier ("http://www.google.fr/search?q=les mots-clés séparés par un espacement")

Dans notre cas :

Private Sub btGoogle_Click()
  Ouvrir_fichier ("http://www.google.com/search?q=" _
              & Me.txtCruAcloner & " " & Me.txtMillesimeAcloner & " " _
              & Me.txtProprioNegoAcloner & " " & Me.cboCategorieAcloner.Column(1))
End Sub

La fonctionnalité « Mise en forme conditionnelle » n'est pas disponible pour un cadre d'options.

Qu'à cela ne tienne, nous allons ruser…

À côté du groupe d'options, nous plaçons une zone de texte avec certaines propriétés communes :

Nous définissons les caractéristiques suivantes pour la mise en forme conditionnelle de la zone de texte :

Nous superposons ces deux contrôles, avec la zone de texte à l'arrière-plan.

Pour garantir que la zone de texte ne reprenne l'avant-plan, ce code dans son événement « Sur réception du focus » :

Private Sub caAppreciationCouleur_GotFocus()
  Me.caAppreciation.SetFocus
End Sub

Un dernière retouche : à ce stade, le choix de l'option « À garder » donnerait ceci :

Ce serait plus lisible si l'étiquette des boutons était en blanc. Allez, faisons joli !

Dans l'événement « Sur activation » du formulaire et après mise à jour de caAppreciation, nous déclencherons cette routine :

Public Sub CouleurEtica()
  Dim i As Integer
  If Me.caAppreciation = 2 Then 'en blanc
      For i = 1 To 3
        Me("etica" & i).BorderColor = 16777215 'blanc
        Me("etica" & i).ForeColor = 16777215 'blanc
      Next i
    Else
      For i = 1 To 3
        Me("etica" & i).BorderColor = 0 'noir
        Me("etica" & i).ForeColor = 0 'noir
      Next i
  End If
End Sub

Et voilà le travail !

Pour supprimer un enregistrement de la table tBouteilles, il faut d'abord supprimer les enregistrements des autres tables qui se réfèrent (éventuellement) à la clé primaire de l'enregistrement à supprimer.

Dans notre cas, il s'agit des enregistrements (éventuels) de tMouvements :

On demandera également le sort à réserver à l'image (éventuellement) associée à l'enregistrement.

Private Sub BtSupprimer_Click()
  Dim iReponse As Integer
  iReponse = MsgBox("Confirmez que vous voulez supprimer cet article", vbOKCancel + vbDefaultButton2)
  If iReponse = vbCancel Then Exit Sub
  'Supprimer l'image (éventuellement)
  If existeFileFSO(CurrentProject.Path & "/Images/" & Me.txttBouteillesPK & ".jpg") = True Then
      iReponse = MsgBox("Voulez-vous aussi supprimer l'image ?", vbYesNo + vbDefaultButton1)
         If iReponse = vbYes Then
            Kill (CurrentProject.Path & "/Images/" & Me.txttBouteillesPK & ".jpg")
         End If
  End If
  DoCmd.SetWarnings False
  'Supprimer les mouvements (éventuels)
  DoCmd.RunSQL ("DELETE * FROM tMouvements WHERE tBouteillesFK=" & Me.txttBouteillesPK & ";")
  DoCmd.RunSQL ("DELETE * FROM tBouteilles WHERE tBouteillesPK=" & Me.txttBouteillesPK & ";")
  DoCmd.SetWarnings True
  Me.Requery
End Sub

La première idée pour créer un enregistrement quasi semblable, c'est de d'abord le copier et ensuite modifier ce qu'il faut.
Dans notre cas, ce n'est pas possible, car pour éviter les doublons (deux bouteilles identiques dans notre base), nous avons placé un index unique sur les colonnes de la table qui singularisent un article :

Donc, la tentative d'ajouter d'abord un enregistrement identique à celui affiché échouerait.

Il faut trouver un moyen pour pouvoir modifier au moins une valeur avant d'ajouter le nouvel enregistrement dans tBouteilles.

Au fait, quels champs faut-il cloner ? Eh bien ! ceux- ci :

Pour simplifier l'écriture du code, nous avons donné un nom « particulier » aux contrôles qui contiennent ces champs, leur nom se termine par « Acloner » : txtCruAcloner, txtMillesimeAcloner, cboAppellationAcloner…

Quand l'utilisateur clique le bouton, le programme va :
- copier le contenu de chaque contrôle suffixé « Acloner » dans sa propriété Remarque ;
- proposer un enregistrement vierge ;
- dans chaque contrôle suffixé « Acloner », reporter le contenu de la propriété Remarque dans la propriété Valeur.

À ce moment, l'utilisateur reprend la main pour modifier ce qu'il faut et sauvegarder ce nouvel enregistrement.

Voici le code :

Private Sub BtCloner_Click()
  Dim oCtl As Control
  'On Error GoTo GestionErreurs
  Me.Refresh
  'une boucle sur tous les contrôles, détecter ceux *Acloner et copier leur contenu
  For Each oCtl In Me.Controls
    If oCtl.Name Like "*Acloner" Then
        Me(oCtl.Name).Tag = Nz(Me(oCtl.Name), " ") 'pour les cas où un champ texte est vide
    End If
  Next oCtl
  'Ouvrir un nouvel enregistrement
  DoCmd.GoToRecord , , acNewRec
  'Retransférer Remarque dans Value
  For Each oCtl In Me.Controls
    If oCtl.Name Like "*Acloner" Then
        Me(oCtl.Name) = Me(oCtl.Name).Tag
    End If
  Next oCtl
GestionErreurs:
  Select Case Err.Number
    Case 0 ' pas d'erreur
    Case Else
      MsgBox "Erreur N° " & Err.Number & " " & Err.Description & vbLf _
                & "dans BtCloner_Click."
  End Select
End Sub

Le clic sur l'un des boutons ouvre le formulaire fMouvements en adaptant sa présentation :

Private Sub BtEntree_Click()
  Me.Refresh 'utile si l'enregistrement est en cours de création
  'S'ils sont ouverts, refermer fJLEntreesSorties et fMouvements
  If CurrentProject.AllForms("fJLEntreesSorties").IsLoaded Then DoCmd.Close acForm, "fJLEntreesSorties"
  If CurrentProject.AllForms("fMouvements").IsLoaded Then DoCmd.Close acForm, "fMouvements"
  'Ouvrir fMouvements juste en dessous du bouton (méthode Arkham46)
  DoCmd.OpenForm "fMouvements", , , , , acHidden
  PositionForm Forms("fMouvements"), Me.BtEntree
  'Adapter la forme de fMouvements pour une entrée
  Forms!fMouvements!txtTitre = "Entrée" & Chr(13) & Chr(10) _
                              & "saisissez un nombre positif" & Chr(13) & Chr(10) _
                              & "dans le champ Nombre."
  Forms!fMouvements!TXTtBouteillesFK = Me.txttBouteillesPK
  Forms!fMouvements.Section("PiedFormulaire").Visible = False
 End Sub

Commentaires du code

DoCmd.OpenForm "FormulaireAPositionner", , , , , acHidden
PositionForm Forms("FormulaireAPositionner"), Me.UneZoneDeTexte

Et un code semblable pour un clic sur l'autre bouton :

Private Sub BtSortie_Click()
  'S'ils sont ouverts, refermer fJLEntreesSorties et fMouvements
  If CurrentProject.AllForms("fJLEntreesSorties").IsLoaded Then DoCmd.Close acForm, "fJLEntreesSorties"
  If CurrentProject.AllForms("fMouvements").IsLoaded Then DoCmd.Close acForm, "fMouvements"
  'Ouvrir fMouvements juste en dessous du bouton (méthode Arkham46)
  DoCmd.OpenForm "fMouvements", , , , , acHidden
  PositionForm Forms("fMouvements"), Me.BtSortie
  'Adapter la forme de fMouvements pour une sortie
  Forms!fMouvements!txtTitre = "Sortie" & Chr(13) & Chr(10) _
                              & "saisissez un nombre négatif" & Chr(13) & Chr(10) _
                              & "dans le champ Nombre."
  Forms!fMouvements!TXTtBouteillesFK = Me.txttBouteillesPK
  Forms!fMouvements!etiPrix.Visible = False
  Forms!fMouvements!txtPrix.Visible = False
End Sub

Dans les zones de liste, si l'utilisateur propose un texte qui n'est pas encore dans les choix prévus, le programme propose de l'ajouter :

Private Sub cboBuAvec_NotInList(NewData As String, Response As Integer)
  If MsgBox("Voulez-vous ajouter " & NewData & " à la liste des convives ?", _
                       vbYesNo + vbQuestion + vbDefaultButton2, "Ajout") = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO tBuAvec ( BuAvec ) SELECT """ & NewData & """;"
        DoCmd.SetWarnings True
        Response = acDataErrAdded
    Else
        Response = acDataErrContinue
        Me.cboBuAvec.Undo
  End If
            
End Sub
            
Private Sub cboBuSur_NotInList(NewData As String, Response As Integer)
  If MsgBox("Voulez-vous ajouter " & NewData & " à la liste des mets dégustés ?", _
                       vbYesNo + vbQuestion + vbDefaultButton2, "Ajout") = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO tBuSur ( BuSur ) SELECT """ & NewData & """;"
        DoCmd.SetWarnings True
        Response = acDataErrAdded
    Else
        Response = acDataErrContinue
        Me.cboBuAvec.Undo
  End If
End Sub
            
Private Sub cboCommentaire_NotInList(NewData As String, Response As Integer)
  If MsgBox("Voulez-vous ajouter " & NewData & " à la liste des commentaires ?", _
                       vbYesNo + vbQuestion + vbDefaultButton2, "Ajout") = vbYes Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "INSERT INTO tCommentaires ( Commentaire ) SELECT """ & NewData & """;"
        DoCmd.SetWarnings True
        Response = acDataErrAdded
    Else
        Response = acDataErrContinue
        Me.cboBuAvec.Undo
  End If
End Sub

Le clic sur ce bouton ouvre le formulaire fJLEntreesSorties :

Il est seulement possible de modifier un enregistrement, pas d'ajout ni de suppression :

Lorsque l'utilisateur s'apprête à modifier un nombre, le programme contrôle d'abord que cette modification n'entraînera pas un stock négatif :

Private Sub txtMvt_BeforeUpdate(Cancel As Integer)
  'Vérifier que la modif ne provoquera pas un stock négatif
  If Forms!fBouteilles!txtStock - Me.txtMvt.OldValue + Me.txtMvt.Value < 0 Then
    MsgBox "Cette modification entraînerait un stock négatif !", vbCritical
    Cancel = True
    Me.txtMvt.Undo
  End If
End Sub

Si c'est le cas, la modif est refusée et un message est affiché :

La source

La source

La source

On part de la requête rRepartition :

… que nous allons convertir en requête d'analyse croisée à l'aide de l'interface proposée par Access.

Voici les différentes étapes :

1° affichez la fenêtre des objets à l'onglet « Requêtes ». Cliquez sur « Nouveau ». Dans la fenêtre qui vient, sélectionnez « Assistant Requête analyse croisée » et cliquez le bouton « Suivant> » :

2° répondez à la série de questions :

3° terminez en donnant un nom significatif à la requête croisée :

4° il vient :

… qui servira de source à l'état eRepartition :

La source

Procédure pour imprimer sur deux colonnes