I. Introduction▲
Dans les entreprises les outils statistiques sont indispensables.
Dès la facturation mensuelle terminée, il est courant d'éditer les statistiques correspondantes.
Mais pour qu'elles soient pertinentes, ces statistiques doivent être comparées à d'autres.
Il y a plusieurs façons de faire ces comparaisons, mais il est fréquent de les établir sur des périodes que l'on appelle "glissantes" ou "mobiles".
Cela veut dire que par rapport à un mois de référence (généralement le dernier mois complet), on remonte sur 3, 6 ou le plus souvent 12 mois.
Les dates n'étant jamais les mêmes, la difficulté pour établir ces rapports, réside dans le fait que les critères d'extraction des données ne sont pas fixes.
Nous allons donc nous pencher sur un processus capable d'automatiser ces extractions.
Il est recommandé d'avoir une certaine expérience d'Access et de son langage, pour comprendre et adapter ce tutoriel à vos spécificités.
I-A. Illustration▲
Nous allons dans le petit exemple qui suit, démontrer que, quelles que soient les périodes déterminées, les résultats vont s'afficher de façon dynamique dans des documents uniques.
I-A-1. Base de départ▲
Pour illustrer tout cela, nous prendrons pour support la base "Les comptoirs".
I-A-2. Objectifs▲
L'objectif va être de consulter l'évolution des ventes mensuelles de toutes les références de produits, sur un choix de 4 périodes avec un mois de référence à sélectionner dans une liste.
Pour cela:
- Nous créerons un formulaire d'accueil permettant de choisir un mois de référence et une période.
- Nous établirons un processus permettant de visualiser les résultats correspondants au choix fait dans le formulaire.
- Nous créerons un état unique récapitulatif.
I-A-3. Aperçus▲
Voici trois exemples de ce que nous pouvons obtenir.
I-A-3-a. Exemple1▲
Dans le formulaire d'accueil nous sélectionnons un mois de référence et une période d'analyse.
Si nous visualisons les données, nous avons bien les données par produits sur six mois, de Octobre/97 à Mars/98.
Les en-têtes de colonnes correspondent aux mois demandés.
Si nous ouvrons l'état avec les mêmes paramètres, nous avons bien les six mois correspondants .
I-A-3-b. Exemple2▲
Nous choisissons d'autres critères.
Nous avons bien trois mois affichés, de Novembre/97 à Janvier/98 et les en-têtes de colonnes correspondent à ce qui est demandé.
I-A-3-c. Exemple3▲
Si nous ouvrons l'état en ayant pris comme mois de référence Novembre/97 et une période annuelle.
Les douze mois correspondent bien à la période choisie.
II. Mise en place▲
Nous allons maintenant détailler la façon d'arriver à ces résultats.
II-A. Tables▲
Trois tables suffiront:
- La table "Commandes".
- La table "Detail_Commandes".
- La table "Produits".
Voici un aperçu de ces tables en mode Création:
Et en mode Feuille de données:
II-B. Zones de choix du formulaire d'accueil▲
Nous allons créer notre formulaire d'accueil "Frm_Accueil" dans lequel nous placerons:
- Un bouton "Cmd_OpenTable" destiné à ouvrir la table qui va nous afficher les résultats.
- Un bouton "Cmd_OpenReport" destiné à ouvrir un état récapitulatif.
- Une ListBox "Lst_Periode".
- Une ComboBox "Cbo_MoisRef".
II-B-1. Propriétés ListBox▲
Dans cet exemple la ListBox comprend 2 colonnes:
- Une visible, comprenant les intitulés des périodes "Année", "Semestre", "Trimestre", "Mois".
- Une autre, invisible comprenant le nombre de mois correspondants aux libellés de la première colonne
"12", "6", "3", "1".
Pour rendre cette colonne invisible nous réglons sa largeur sur 0 cm.
C'est cette colonne qui sera prise en compte dans nos calculs à venir.
Voici une vue d'une partie de la fenêtre des propriétés de la ListBox
II-B-2. Propriétés ComboBox▲
Contrairement à la ListBox, nous ne remplissons pas la propriété "Contenu". Elle sera définie dynamiquement.
La propriété "Origine source" sera réglée sur "Liste valeurs".
Voici une vue d'une partie de la fenêtre de propriété.
Valeurs dynamiques de la propriété "Contenu":
Nous mettons par exemple une sélection de 12 mois disponibles par rapport au mois de Mai/98.
Nous passons par le code à l'ouverture de notre formulaire.
Private Sub Form_Open(Cancel As Integer)
Dim i As Integer
Dim strSource As String
'Nous créons une boucle sur 12 mois
For i = 1 To 12
'Pour période à partir du dernier mois complet
'strSource = strSource & _
' Format(DateAdd("m", -i, Date), "mmm/yy")& ";"
'Pour période à partir du mois en cours
'strSource = strSource & _
' Format(DateAdd("m", -i + 1, Date), "mmm/yy")& ";"
'Pour période du fichier exemple
strSource = strSource & _
Format(DateAdd("m", -i + 1, #5/1/1998#), "mmm/yy") & ";"
Next i
'Nous attribuons comme source de notre ComboBox les résultats de la boucle.
Me.Cbo_MoisRef.RowSource = strSource
End Sub
Dans ce code, vous remarquerez que j'ai mis trois possibilités pour le choix du mois de référence.
Voici les résultats obtenus avec ces 3 cas:
La base exemple étant figée, nous avons choisi une date de départ fixe (Mai/98).
Dans la réalité, nous travaillerons par rapport au mois en cours, ou par rapport au dernier mois complet.
Si, comme c'est le plus probable, vous choisissez comme mois de référence le dernier mois complet, vous aurez:
Private Sub Form_Open(Cancel As Integer)
Dim i As Integer
Dim strSource As String
'Nous créons une boucle sur 12 mois
For i = 1 To 12
'Pour période à partir du dernier mois complet
strSource = strSource & _
Format(DateAdd("m", -i, Date), "mmm/yy")& ";"
Next i
'Nous attribuons comme source de notre ComboBox les résultats de la boucle.
Me.Cbo_MoisRef.RowSource = strSource
End SubII-C. Processus de calcul▲
Il y a bien sûr plusieurs façons d'aborder ce problème:
- On peut créer autant de requêtes que de mois, modifier les critères manuellement, et faire une requête récapitulative.
- On peut créer une table de correspondance de mois, puis toujours dans les mêmes requêtes, mettre comme critères les données de cette table.
- On peut créer une requête d'analyse croisée.
- On peut utiliser une requête de sélection et créer dynamiquement deux tables temporaires.
C'est cette dernière solution que je vous propose.
Certes elle est un peu moins rapide que la troisième faisant appel juste au Sql, mais cette solution nous permettra
également de réviser ou découvrir des notions souvent évoquées sur le Forum, en particulier les manipulations de données avec Dao.
En effet nous mettrons en pratique les opérations suivantes:
- Création de tables.
- Insertion de données.
- Mise à jour de données.
- Ajout de propriétés à une table.
- Modification d'une requête.
- Suppression d'une table.
Pour en savoir plus, je vous invite à lire soigneusement le tutoriel de Tofalu sur le lien suivant: https://warin.developpez.com/access/dao/.
II-C-1. Principes▲
Pour comprendre le processus voici le cheminement nécessaire.
II-C-1-a. Etape1.▲
Calcul du chiffre d'affaires mensuel par produit.
Nous passerons par la création d'une requête "Qry_CalculCa", basée sur les tables "Commandes" et "Détail_Commandes".
II-C-1-b. Etape2▲
Remplissage d'une table temporaire "Tbl_Temp_CaMois" avec le contenu de la requête.
Nous devrons donc créer cette table dynamiquement et lui insérer les données de la requête "Qry_CalculCa".
II-C-1-c. Etape3▲
Création d'une table temporaire "Tbl_Temp_Recap" contenant tous les produits.
Nous y ajouterons également les colonnes mensuelles correspondant à la période choisie.
.
II-C-1-d. Etape4▲
Mise à jour colonne par colonne, de la table "Tbl_Temp_Recap".
Les données réactualisées mois par mois proviendront de la table "Tbl_Temp_MoisCa".
S'il n'y a pas eu de ventes sur un produit pendant un mois donné, la valeur restera à 0.
Nous aurions pu avoir la tentation de faire la mise à jour de la table "Tbl_Temp_Recap", directement à partir de la requête "Qry_CalculCa".
Cela nous aurait évité la création et la mise à jour de la table "Tbl_Temp_CaMois".
Malheureusement, lors du lancement de cette requête Access provoque une erreur 3073 "l'opération doit utiliser une requête qui peut être mise à jour".
Pour la contourner, il faudrait passer par une fonction de recherche dans un domaine (Dlookup), mais cela est beaucoup moins rapide.
II-C-2. Réalisation▲
Nous allons maintenant détailler ces étapes.
II-C-2-a. Création de la requête▲
Nous avons besoin de trois champs:
- "Ref_Produit" sur lequel nous ferons un regroupement.
- "Mois_Commande" sur lequel nous ferons un regroupement.
- "Ca" correspondant à la somme de "Prix_unitaire * Quantité".
Si nous faisons un regroupement sur les dates telles qu'elles sont enregistrées, nous aurons en fait, le chiffre d'affaires obtenu par produit et par jour de commande.
Comme nous voulons un récapitulatif mensuel par mois, il nous faut soit:
- Mettre le champ Date_Commande au format Mois/Année.
- Modifier les dates pour qu'elles soient toutes au premier de chaque mois.
Nous choisirons la deuxième méthode, qui permet de garder un format de type Date.
Nous utiliserons pour ces modifications, la fonction DateSerial:
II-C-2-a-i. Rappel sur la fonction DateSerial▲
Cette fonction se présente ainsi: "DateSerial(année, mois, jour)"
Exemple:
Imaginons un champ "MyDate" ayant pour valeur le #22/08/2009#.
La fonction DateSerial "DateSerial(Year(MyDate), Month(MyDate),1) retournera la valeur #01/08/2009#.
Pour en savoir plus sur les fonctions Date/Heure, Maxence Hubiche nous a rédigé une excellente synthèse ici.
II-C-2-a-ii. Code de la requête▲
Voici donc le code de création de la requête en mode Sql:
SELECT Details_Commandes.Ref_Produit, Sum(Details_Commandes.Quantité*Details_Commandes.Prix_unitaire) AS CA,
DateSerial(Year(Commandes.Date_commande),Month(Commandes.Date_commande),1) AS Mois_Commande
FROM Commandes INNER JOIN Details_Commandes ON Commandes.N°_Commande = Details_Commandes.N°_Commande
GROUP BYDetails_Commandes.Ref_Produit, DateSerial(Year(Commandes.Date_commande),Month(Commandes.Date_commande),1);
Ou en mode générateur:
Vous remarquerez que dans cette requête, il n'y a aucun critère d'établi.
Tout simplement, parce que lors de notre processus, elle va être modifiée dynamiquement, autant de fois qu'il y aura de mois à prendre en compte.
A chaque modification, un critère sera appliqué sur le champ "Mois_Commande".
II-C-2-b. Code nécessaire▲
Nous allons passer au code Vba nécessaire.
II-C-2-b-i. Création module▲
Il nous faut donc maintenant créer le code correspondant à toutes ces opérations.
Pour cela nous nous rendons par les touches Alt + F11 dans la fenêtre Microsoft Visual Basic.
En fonction de notre version d'Access, nous nous assurons que la référence "Microsoft DAO 3.5 Object Library" ou "Microsoft DAO 3.6 Object Library" est cochée.
Puis nous créons un module que nous appellerons "Mdl_MiseAJour".
II-C-2-b-ii. Fonction de vérification d'existence de table▲
Afin d'éviter les messages d'erreur lors des suppressions et créations des tables, nous allons créer une fonction qui nous permettra de vérifier la présence ou non de ces tables.
Nous allons donc commencer notre code par cette fonction.
Option Compare Database
Option Explicit
Function VerifExistTable(StrNomTable As String) As Boolean
Dim tblTable As DAO.TableDef
Dim oDb As DAO.Database
Set oDb = CurrentDb
VerifExistTable = False
For Each tblTable In oDb.TableDefs
If tblTable.Name = StrNomTable Then
VerifExistTable = True
Exit For
End If
Next
End FunctionII-C-2-b-iii. Code de création de la table "Tbl_Temp_CaMois"▲
Nous écrivons la procédure de création de cette table.
Public Sub Crea_Tbl_Temp_Ca()
Dim oDb As DAO.Database
Dim oNewTable As DAO.TableDef
Dim StrNomTable As String
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
StrNomTable = "Tbl_Temp_CaMois"
Set oDb = CurrentDb
'Crée la nouvelle table
Set oNewTable = oDb.CreateTableDef(StrNomTable)
With oNewTable
'Crée le champ Ref_Produit en type Numérique Entier Long
.Fields.Append .CreateField("Ref_Produit", dbLong)
'Crée le champ Mois en type Date
.Fields.Append .CreateField("Mois", DB_DATE)
'Crée le champ Ca en mode monétaire avec comme valeur par défaut 0
Set oChamp = .CreateField("Ca", dbCurrency)
oChamp.DefaultValue = 0
.Fields.Append oChamp
'Définit la clé primaire sur Ref_Produit
Set oIndex = .CreateIndex("PK_Ref_Produit")
With oIndex
.Primary = True
.Fields.Append .CreateField("Ref_Produit")
End With
'Ajoute l'index à la table
.Indexes.Append oIndex
End With
'Ajoute la table à la base de données
oDb.TableDefs.Append oNewTable
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNewTable = Nothing
Set oDb = Nothing
End Sub
Si nous lançons cette procédure, et si nous ouvrons la table ainsi créée nous obtenons:
II-C-2-b-iv. Code de création de la table "Tbl_Temp_Recap"▲
La procédure de création de cette table est un peu plus complexe, car il va falloir :
- Ajouter un nombre de champs variable correspondant au nombre de mois souhaité.
- Leur attribuer une légende également variable.
- Mettre une valeur 0 par défaut à tous les champs mensuels, afin d'éviter les problèmes de valeur Null, quand il n'y aura pas eu de vente.
Public Sub Crea_Tbl_Temp_Recap()
Dim oDb As DAO.Database
Dim oNewTable As DAO.TableDef
Dim StrNomTable As String
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
Dim DateRef As Date 'variable Mois de référence du formulaire Accueil
Dim MoisCritere As Date 'variable du mois qui va servir de critère à la requête Qry_CalculCa
Dim NbMois As Integer 'variable définissant l'amplitude de la boucle
Dim MaPropriete As Property
Dim i As Integer
StrNomTable = "Tbl_Temp_Recap"
Set oDb = CurrentDb
'Donne à la variable NbMois, la valeur donnée de la deuxième colonne de la liste du formulaire d'accueil
NbMois = Form_Frm_Accueil.Lst_Periode.Column(1)
'Crée la nouvelle table Tbl_Temp_Recap
Set oNewTable = oDb.CreateTableDef(StrNomTable)
With oNewTable
'Crée le champ Ref_Produit de type Numérique Entier Long
.Fields.Append .CreateField("Ref_Produit", dbLong)
'Crée avec une boucle les champs Ca_1 à "Nb de mois de la ListBox" de type monétaire avec valeur par défaut 0
For i = 1 To NbMois
Set oChamp = .CreateField("Ca_" & i, dbCurrency)
oChamp.DefaultValue = 0
.Fields.Append oChamp
Next
'définit la clé primaire sur Ref_Produit
Set oIndex = .CreateIndex("PK_Ref_Produit")
With oIndex
.Primary = True
.Fields.Append .CreateField("Ref_Produit")
End With
'Ajoute l'index à la table
.Indexes.Append oIndex
End With
'Ajoute la table à la base de données
oDb.TableDefs.Append oNewTable
'Nous créons pour chaque champ une légende correspondant au mois sélectionné
'Attribue à la variable DateRef la valeur de la Combo Box
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
'Crée une boucle de 1 au nombre de mois demandé dans la zone de liste
For i = 1 To NbMois
'Détermine le nom de chaque mois correspondant à la boucle
MoisCritere = DateAdd("m", i, DateRef)
'Ajoute une propriété "Caption" à chaque champ "Ca_*" et lui donne comme légende la valeur "MoisCritere"
Set MaPropriete = oNewTable.Fields("Ca_" & i).CreateProperty("Caption", dbText)
MaPropriete.Value = Format(MoisCritere, "mmm yy")
oNewTable.Fields("Ca_" & i).Properties.Append MaPropriete
Next
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNewTable = Nothing
Set oDb = Nothing
End Sub
Si nous lançons la procédure avec les paramètres de l'exemple1, nous obtenons:
II-C-2-b-v. Fonction d'enchaînement▲
Il nous reste dans ce module à créer la fonction qui enchaîne tout le processus des Etapes 2, 3 et 4.
Nous démarrons la procédure par la déclaration des variables et par la reconnaissance du mois de départ de la procédure.
Public Function MiseAjour() 'Mise à jour de la requête Qry_CalculCa + création des tables et remplissage
On Error GoTo Error_Maj
Dim oDb As DAO.Database
Dim StrNomTable As String
Dim oQdf As DAO.QueryDef
Dim StrSql As String
Dim Tdf As DAO.TableDef
Dim DateRef As Date 'variable Mois de référence du formulaire Accueil
Dim MoisCritere As Date 'variable du mois qui va servir de critère à la requête Qry_CalculCa
Dim NbMois As Integer 'variable définissant l'amplitude de la boucle
Dim MaPropriete As Property
Dim i As Integer
'Attribue à la variable la valeur de la liste déroulante du formulaire d'accueil
NbMois = Form_Frm_Accueil.Lst_Periode.Column(1)
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
Nous vérifions la présence ou non de la table "Tbl_Temp_Recap" et nous appelons la procédure de création.
'Crée la table Tbl_Temp_Recap
StrNomTable = "Tbl_Temp_Recap"
Set oDb = CurrentDb
'Si la table existe on la supprime puis on appelle la fonction de création
If VerifExistTable(StrNomTable:=StrNomTable) = True Then
oDb.TableDefs.Delete StrNomTable
Call Crea_Tbl_Temp_Recap
'Sinon on la crée en appelant la fonction
Else
Call Crea_Tbl_Temp_Recap
End If
Nous remplissons cette table avec les références de tous les produits.
Cela nous permettra de voir également ceux qui n'ont pas été vendus.
'Remplit la colonne Ref_Produits de cette table d'après la table Produits
oDb.Execute "INSERT INTO Tbl_Temp_Recap ( Ref_Produit )" & _
"SELECT Produits.Ref_Produit " & _
"FROM Produits " & _
"ORDER BY Produits.Ref_Produit;"
DoEvents
Nous vérifions la présence ou non de la table "Tbl_Temp_CaMois" et nous appelons la procédure de création.
'Crée la table Tbl_Temp_CaMois
StrNomTable = "Tbl_Temp_CaMois"
If VerifExistTable(StrNomTable:=StrNomTable) = True Then
oDb.TableDefs.Delete StrNomTable
Call Crea_Tbl_Temp_Ca
Else
Call Crea_Tbl_Temp_Ca
End If
Nous démarrons une boucle sur le nombre de mois demandé:
'Crée une boucle qui va mettre à jour nos colonnes en fonction du nombre demandé
For i = 1 To NbMois
A chaque incrémentation de la boucle, nous modifions la requête "Qry_CalculCa" en lui ajoutant un critère correspondant à un mois.
'Attribue à la variable la valeur de la liste déroulante du formulaire d'accueil
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
MoisCritere = DateAdd("m", i, DateRef)
'Modifie la requête Qry_CalculDate
Set oQdf = oDb.QueryDefs("Qry_CalculCa")
StrSql = _
"SELECT Details_Commandes.Ref_Produit, " & _
"Sum(Details_Commandes.Quantité*Details_Commandes.Prix_unitaire) AS CA, " & _
"DateSerial(Year(Commandes.Date_commande),Month(Commandes.Date_commande),1) AS Mois_Commande " & _
"FROM Commandes INNER JOIN Details_Commandes " & _
"ON Commandes.N°_Commande = Details_Commandes.N°_Commande " & _
"GROUP BY Details_Commandes.Ref_Produit," & _
"DateSerial(Year(Commandes.Date_commande),Month(Commandes.Date_commande),1)" & _
"HAVING (((DateSerial(Year(Commandes.Date_commande), " & _
"Month(Commandes.Date_commande),1))=#07/31/1997#)) " & _
"ORDER BY Details_Commandes.Ref_Produit;"
'Remplace le critère par celui calculé par la boucle,
'et nous transformons le format de date américain en format européen
StrSql = _
Replace(StrSql, "#07/31/1997#", Chr(35) & Mid(MoisCritere, 4, 2) & "/" & _
Left(MoisCritere, 2) & "/" & Right(MoisCritere, 4) & Chr(35))
'Applique la modification
oQdf.SQL = StrSql
DoEventsSi nous n'avions pas transformé notre format de date de critère en format européen, et si nous avions mis :
StrSql = _
Replace(StrSql, "#07/31/1997#", Chr(35) & MoisCritere & Chr(35))
Nous aurions eu dans le critère de notre requête modifiée #03/01/2008# au lieu de #01/03/2008#.
Nous poursuivons en supprimant les enregistrements de la table "Tbl_Temp_Ca_Mois" et en y insérant les nouvelles données de la requête.
'Supprime tous les enregistrements éventuels
oDb.Execute "Delete * From Tbl_Temp_CaMois"
'Met à jour la table Tbl_Temp_CaMois d'après les résultats de la requête
oDb.Execute _
"INSERT INTO Tbl_Temp_CaMois(Ref_Produit, Mois, Ca )" & _
"SELECT Qry_CalculCa.Ref_Produit, Qry_CalculCa.Mois_Commande, Qry_CalculCa.Ca " & _
"FROM Qry_CalculCa;"
Nous faisons la mise à jour colonne par colonne de la table "Tbl_Temp_Recap".
'Crée la requête de mise à jour de la table Tbl_Temp_Recap
StrSql = _
"UPDATE Tbl_Temp_Recap " & _
"Inner Join Tbl_Temp_CaMois On Tbl_Temp_Recap.Ref_Produit = Tbl_Temp_CaMois.Ref_Produit " & _
"SET Tbl_Temp_Recap.Ca_1 = Tbl_Temp_CaMois.Ca ;"
'Choisit la colonne à mettre à jour d'après le résultat de la boucle
StrSql = Replace(StrSql, "Tbl_Temp_Recap.Ca_1", "Tbl_Temp_Recap.Ca_" & i)
'Execute la requête de mise à jour.
oDb.Execute StrSql
Next
'Libère les variables
oDb.Close
Set oDb = Nothing
Set oQdf = Nothing
Set Tdf = Nothing
MiseAJour_Exit:
Exit Function
Error_Maj:
MsgBox Error$
Resume MiseAJour_Exit
End Function
Le module est terminé.
Il suffira, une fois nos paramètres sélectionnés dans le formulaire d'accueil, d'appeler la fonction "MiseAjour".
II-C-2-b-vi. Code complet du module▲
Voici récapitulé, le code complet du module:
Option Compare Database
Option Explicit
Function VerifExistTable(StrNomTable As String) As Boolean
Dim tblTable As DAO.TableDef
Dim oDb As DAO.Database
Set oDb = CurrentDb
VerifExistTable = False
For Each tblTable In oDb.TableDefs
If tblTable.Name = StrNomTable Then
VerifExistTable = True
Exit For
End If
Next
End Function
Public Sub Crea_Tbl_Temp_Ca()
Dim oDb As DAO.Database
Dim oNewTable As DAO.TableDef
Dim StrNomTable As String
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
StrNomTable = "Tbl_Temp_CaMois"
Set oDb = CurrentDb
'Crée la nouvelle table
Set oNewTable = oDb.CreateTableDef(StrNomTable)
With oNewTable
'Crée le champ Ref_Produit en type Numérique Entier Long
.Fields.Append .CreateField("Ref_Produit", dbLong)
'Crée le champ Mois en type Date
.Fields.Append .CreateField("Mois", DB_DATE)
'Crée le champ Ca en mode monétaire avec comme valeur par défaut 0
Set oChamp = .CreateField("Ca", dbCurrency)
oChamp.DefaultValue = 0
.Fields.Append oChamp
'Définit la clé primaire sur Ref_Produit
Set oIndex = .CreateIndex("PK_Ref_Produit")
With oIndex
.Primary = True
.Fields.Append .CreateField("Ref_Produit")
End With
'Ajoute l'index à la table
.Indexes.Append oIndex
End With
'Ajoute la table à la base de données
oDb.TableDefs.Append oNewTable
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNewTable = Nothing
Set oDb = Nothing
End Sub
Public Sub Crea_Tbl_Temp_Recap()
Dim oDb As DAO.Database
Dim oNewTable As DAO.TableDef
Dim StrNomTable As String
Dim oChamp As DAO.Field
Dim oIndex As DAO.Index
Dim DateRef As Date 'variable Mois de référence du formulaire Accueil
Dim MoisCritere As Date 'variable du mois qui va servir de critère à la requête Qry_CalculCa
Dim NbMois As Integer 'variable définissant l'amplitude de la boucle
Dim MaPropriete As Property
Dim i As Integer
StrNomTable = "Tbl_Temp_Recap"
Set oDb = CurrentDb
'Donne à la variable NbMois, la valeur donnée de la deuxième colonne de la liste du formulaire d'accueil
NbMois = Form_Frm_Accueil.Lst_Periode.Column(1)
'Crée la nouvelle table Tbl_Temp_Recap
Set oNewTable = oDb.CreateTableDef(StrNomTable)
With oNewTable
'Crée le champ Ref_Produit de type Numérique Entier Long
.Fields.Append .CreateField("Ref_Produit", dbLong)
'Crée avec une boucle les champs Ca_1 à "Nb de mois de la ListBox" de type monétaire avec valeur par défaut 0
For i = 1 To NbMois
Set oChamp = .CreateField("Ca_" & i, dbCurrency)
oChamp.DefaultValue = 0
.Fields.Append oChamp
Next
'définit la clé primaire sur Ref_Produit
Set oIndex = .CreateIndex("PK_Ref_Produit")
With oIndex
.Primary = True
.Fields.Append .CreateField("Ref_Produit")
End With
'Ajoute l'index à la table
.Indexes.Append oIndex
End With
'Ajoute la table à la base de données
oDb.TableDefs.Append oNewTable
'Nous créons pour chaque champ une légende correspondant au mois sélectionné
'Attribue à la variable DateRef la valeur de la Combo Box
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
'Crée une boucle de 1 au nombre de mois demandé dans la zone de liste
For i = 1 To NbMois
'Détermine le nom de chaque mois correspondant à la boucle
MoisCritere = DateAdd("m", i, DateRef)
'Ajoute une propriété "Caption" à chaque champ "Ca_*" et lui donne comme légende la valeur "MoisCritere"
Set MaPropriete = oNewTable.Fields("Ca_" & i).CreateProperty("Caption", dbText)
MaPropriete.Value = Format(MoisCritere, "mmm yy")
oNewTable.Fields("Ca_" & i).Properties.Append MaPropriete
Next
'Libère les variables
oDb.Close
Set oIndex = Nothing
Set oChamp = Nothing
Set oNewTable = Nothing
Set oDb = Nothing
End Sub
Public Function MiseAjour() 'Mise à jour de la requête Qry_CalculCa + création des tables et remplissage
On Error GoTo Error_Maj
Dim oDb As DAO.Database
Dim StrNomTable As String
Dim oQdf As DAO.QueryDef
Dim StrSql As String
Dim Tdf As DAO.TableDef
Dim DateRef As Date 'variable Mois de référence du formulaire Accueil
Dim MoisCritere As Date 'variable du mois qui va servir de critère à la requête Qry_CalculCa
Dim NbMois As Integer 'variable définissant l'amplitude de la boucle
Dim MaPropriete As Property
Dim i As Integer
'Attribue à la variable la valeur de la liste déroulante du formulaire d'accueil
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
'Crée la table Tbl_Temp_Recap
StrNomTable = "Tbl_Temp_Recap"
Set oDb = CurrentDb
'Si la table existe on la supprime puis on la crée
If VerifExistTable(StrNomTable:=StrNomTable) = True Then
oDb.TableDefs.Delete StrNomTable
Call Crea_Tbl_Temp_Recap
'Sinon on la crée en appelant la fonction
Else
Call Crea_Tbl_Temp_Recap
End If
'Remplit la colonne Ref_Produits de cette table d'après la table Produits
oDb.Execute "INSERT INTO Tbl_Temp_Recap ( Ref_Produit )" & _
"SELECT Produits.Ref_Produit " & _
"FROM Produits " & _
"ORDER BY Produits.Ref_Produit;"
DoEvents
'Crée la table Tbl_Temp_CaMois
StrNomTable = "Tbl_Temp_CaMois"
If VerifExistTable(StrNomTable:=StrNomTable) = True Then
oDb.TableDefs.Delete StrNomTable
Call Crea_Tbl_Temp_Ca
Else
Call Crea_Tbl_Temp_Ca
End If
'Attribue à la variable le Nb de mois contenu dans la liste période du formulaire d'accueil
NbMois = Form_Frm_Accueil.Lst_Periode.Column(1)
'Crée une boucle qui va mettre à jour nos colonnes en fonction du nombre demandé
For i = 1 To NbMois
'Attribue à la variable la valeur de la liste déroulante du formulaire d'accueil
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
MoisCritere = DateAdd("m", i, DateRef)
'Modifie la requête Qry_CalculCa
Set oQdf = oDb.QueryDefs("Qry_CalculCa")
StrSql = "SELECT Details_Commandes.Ref_Produit, " & _
"Sum(Details_Commandes.Quantité*Details_Commandes.Prix_unitaire) AS CA, " & _
"DateSerial(Year(Commandes.Date_commande),Month(Commandes.Date_commande),1) AS Mois_Commande " & _
"FROM Commandes INNER JOIN Details_Commandes " & _
"ON Commandes.N°_Commande = Details_Commandes.N°_Commande " & _
"GROUP BY Details_Commandes.Ref_Produit," & _
"DateSerial(Year(Commandes.Date_commande),Month(Commandes.Date_commande),1)" & _
"HAVING (((DateSerial(Year(Commandes.Date_commande), " & _
"Month(Commandes.Date_commande),1))=#07/31/1997#)) " & _
"ORDER BY Details_Commandes.Ref_Produit;"
'Remplace le critère par celui calculé par la boucle, et remplace le format de date américain en format européen
StrSql = _
Replace(StrSql, "#07/31/1997#", Chr(35) & Mid(MoisCritere, 4, 2) & "/" & _
Left(MoisCritere, 2) & "/" & Right(MoisCritere, 4) & Chr(35))
'Applique la modification
oQdf.SQL = StrSql
DoEvents
'Supprime tous les enregistrements éventuels
oDb.Execute "Delete * From Tbl_Temp_CaMois"
'Met à jour la table Tbl_Temp_CaMois d'après les résultats de la requête
oDb.Execute "INSERT INTO Tbl_Temp_CaMois(Ref_Produit, Mois, Ca )" & _
"SELECT Qry_CalculCa.Ref_Produit, Qry_CalculCa.Mois_Commande, Qry_CalculCa.Ca " & _
"FROM Qry_CalculCa;"
'Crée la requête de mise à jour de la table Tbl_Temp_Recap
StrSql = "UPDATE Tbl_Temp_Recap " & _
"Inner Join Tbl_Temp_CaMois On Tbl_Temp_Recap.Ref_Produit = Tbl_Temp_CaMois.Ref_Produit " & _
"SET Tbl_Temp_Recap.Ca_1 = Tbl_Temp_CaMois.Ca ;"
'Choisit la colonne à mettre à jour d'après le résultat de la boucle
StrSql = Replace(StrSql, "Tbl_Temp_Recap.Ca_1", "Tbl_Temp_Recap.Ca_" & i)
'Execute la requête de mise à jour.
oDb.Execute StrSql
Next
'Libère les variables
oDb.Close
Set oDb = Nothing
Set oQdf = Nothing
Set Tdf = Nothing
MiseAJour_Exit:
Exit Function
Error_Maj:
MsgBox Error$
Resume MiseAJour_Exit
End FunctionIII. Création de l'état récapitulatif.▲
Travaillant essentiellement avec les tandems .mde-Runtime ou .accde-Runtime, la création des labels et champs ne peut être dynamique.
C'est pour cela que je vous propose la méthode suivante.
Nous créons l'état pour le maximum de mois envisagés (dans notre exemple 12).
Les labels correspondants aux colonnes de mois ont une suite de noms logiques: "Lbl_Mois_1", "Lbl_Mois_2", "Lbl_Mois_3" ....
Nous leur donnons une valeur quelconque: 1 , 2 , 3 ....
Les zones de texte Détail correspondantes aux labels ont une suite de noms logiques: "Txt_Mois_1", "Txt_Mois_2", "Txt_Mois_3" ....
Les zones de texte Pied d'état correspondantes aux labels ont une suite de noms logiques: "Txt_Total_1", "Txt_Total_2", "Txt_Total_3" ....
La source de l'état n'est jamais la même, puisque la table "Tlb_Temp_Recap", n'a pas toujours le même nombre de champs.
Pour afficher l'état souhaité, nous devrons donc dynamiquement et successivement:
- Rendre "indépendant" toutes les zones de textes "Txt_Mois" et "Txt_Total".
- Rendre invisibles toutes ces zones ainsi que les labels "Lbl_Mois".
- Créer la source de l'état.
- Attribuer un Control Source aux zones de textes "Txt_Mois" et "Txt_Total" correspondantes au nombre de mois choisi.
- Attribuer un nom aux labels concernés.
- Rendre visibles ces mêmes zones et labels.
Voici donc le code correspondant à toutes ces opérations.
Private Sub Report_Open(Cancel As Integer)
Dim StrNomTable As String
Dim DateRef As Date
Dim MoisCritere As Date
Dim StrSource As String ' variable Select suivant nb de mois
Dim NbMois As Integer
Dim i As Integer
For i = 1 To 12 'Correspond à la valeur maxi que nous traitons ici
'Rend invisibles tous les labels
Me.Controls("Lbl_Mois_" & i).Visible = False
'Met tous les contrôles Txt_Mois en indépendant et les rend invisibles
With Me.Controls("Txt_Mois_" & i)
.ControlSource = ""
.Visible = False
End With
'Met tous les contrôles Txt_Total en indépendant et les rend invisibles
With Me.Controls("Txt_Total_" & i)
.ControlSource = ""
.Visible = False
End With
Next
'Indique le nom de la table à traiter
StrNomTable = "Tbl_Temp_Recap"
'Détermine le nb de mois à traiter d'après le contenu de la ListBox
NbMois = Form_Frm_Accueil.Lst_Periode.Column(1)
'Attribue à la variable la valeur de départ de la période
DateRef = DateAdd("m", -NbMois, Form_Frm_Accueil.Cbo_MoisRef.Value)
For i = 1 To NbMois
'Crée la chaîne de sélection des champs pour la source de la requête
StrSource = StrSource & ", " & StrNomTable & "." & "Ca_" & i
'Crée la source du l'état en introduisant la chaîne de la variable StrSource
Me.RecordSource = _
"SELECT Tbl_Temp_Recap.Ref_Produit, Produits.Nom_Produit " & StrSource & " " & _
"FROM Tbl_Temp_Recap INNER JOIN Produits ON Tbl_Temp_Recap.Ref_Produit = Produits.Ref_Produit;"
'Donne une valeur à la variable MoisCritere
MoisCritere = DateAdd("m", i, DateRef)
'Donne à chaque Label_Mois le nom correspondant au résultat de la boucle et le rehs visible
With Me.Controls("Lbl_Mois_" & i)
.Caption = Format(MoisCritere, "mmm yy")
.Visible = True
End With
'Attribue une source aux contrôles Txt_Mois et les rend visibles
With Me.Controls("Txt_Mois_" & i)
.ControlSource = "Ca_" & i
.Visible = True
End With
'Attribue une source aux contrôles Txt_Total et les rend visibles
With Me.Controls("Txt_Total_" & i)
.ControlSource = "=Sum(Ca_" & i & ")"
.Visible = True
End With
Next
End SubIV. Evènements sur boutons du formulaire "frm_Accueil"▲
Nous pouvons maintenant mettre sur les propriétés "Sur Clic" de chaque bouton du formulaire d'accueil, la procédure évènementielle correspondante.
Sur le bouton "Cmd_OpenTable"
Private Sub Cmd_OpenTable_Click()
On Error GoTo Err_Cmd_OpenTable_Click
'Met un message d'erreur si rien n'a été sélectionné dans la ComboBox
If IsNull(Me.Cbo_MoisRef.Value) Then
Call MsgBox("Vous devez sélectionner un mois de référence.", vbExclamation, "Attention")
Me.Cbo_MoisRef.SetFocus
Else
Application.Echo False
'appelle la fonction de mise à jour
Call MiseAjour
DoEvents
'Ouvre la table
Dim stDocName As String
stDocName = "Tbl_Temp_Recap"
DoCmd.OpenTable stDocName, acViewNormal, acReadOnly
DoCmd.Maximize
Application.Echo True
End If
Exit_Cmd_OpenTable_Click:
Exit Sub
Err_Cmd_OpenTable_Click:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Attention"
Resume Exit_Cmd_OpenTable_Click
End Sub
Sur le bouton "Cmd_OpenReport"
Private Sub Cmd_OpenReport_Click()
On Error GoTo Err_Cmd_OpenReport_Click
DoCmd.RunCommand acCmdWindowHide
'Met un message d'erreur si rien n'a été sélectionné dans la ComboBox
If IsNull(Me.Cbo_MoisRef.Value) Then
Call MsgBox("Vous devez sélectionner un mois de référence.", vbExclamation, "Attention")
Me.Cbo_MoisRef.SetFocus
Else
'Ouvre l'état
Application.Echo False
'Attribue la valeur 12 à la ListBox puisque nous voulons une année mobile.
Me.Lst_Periode.Value = Me.Lst_Periode.ItemData(0)
'Appelle la procédure de mise à jour
Call MiseAjour
DoEvents
'Ouvre l'état
Dim stDocName As String
stDocName = "Etat_Recap"
DoCmd.OpenReport stDocName, acViewPreview
DoCmd.Maximize
Application.Echo True
End If
Exit_Cmd_OpenReport_Click:
Exit Sub
Err_Cmd_OpenReport_Click:
MsgBox Err.Description
Resume Exit_Cmd_OpenReport_Click
End SubV. Fermeture de la base▲
Lors de la fermeture de la base il est conseillé de supprimer les deux tables temporaires.
Nous mettons donc le code suivant sur l'évènement "Fermeture" du formulaire d'accueil:
Private Sub Form_Close()
On Error GoTo Err_Form_Close
Dim StrNomTable As String
Dim oDb As DAO.Database
Set oDb = CurrentDb
StrNomTable = "Tbl_Temp_CaMois"
If VerifExistTable(StrNomTable) Then
oDb.TableDefs.Delete StrNomTable
End If
StrNomTable = "Tbl_Temp_Recap"
If VerifExistTable(StrNomTable) Then
oDb.TableDefs.Delete StrNomTable
End If
oDb.Close
Set oDb = Nothing
Exit_Form_Close:
Exit Sub
Err_Form_Close:
'Erreur si la table est encore ouverte
If Err.Number = 3211 Then
DoCmd.Close acTable, StrNomTable
If VerifExistTable(StrNomTable) Then
oDb.TableDefs.Delete StrNomTable
End If
Else
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Attention"
End If
Resume Exit_Form_Close
End SubVI. Conclusions▲
Nous avons maintenant terminé.
Comme vous le voyez, avec un formulaire de sélection, une requête, deux tables temporaires et un état, nous arrivons à pouvoir visualiser des résultats sur des périodes très différentes.
Cette petite application fictive, n'est bien sûr qu'un petit exemple de tout ce que l'on peut faire de cette façon.
C'est donc un point de départ qui, je l'espère, vous aidera dans la conception de vos outils d'analyse.
Vous pouvez télécharger le fichier servant d'exemple. Il peut être lu avec les versions 2000-2007
VII. Remerciements▲
Un grand Merci à toute l'équipe de Dvp et plus particulièrement:
Pour leurs remarques et conseils avisés:
. Domi2
. Philippe JOCHMANS
. User
. Jeannot45
. Tofalu
. Pierre Fauconnier
Pour leurs corrections orthographiques et syntaxiques:
. Jacques jean
. Eravisnea