Processus de calcul de statistiques dynamiques sur des périodes mobiles.

Mise en place d'un processus permettant de calculer des statistiques sur des périodes mobiles.

17 commentaires Donner une note à l'article (5)

Article lu   fois.

L'auteur

Site personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

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.

Image non disponible


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.

Image non disponible


Si nous ouvrons l'état avec les mêmes paramètres, nous avons bien les six mois correspondants .

Image non disponible

I-A-3-b. Exemple2


Nous choisissons d'autres critères.

Image non disponible


Nous avons bien trois mois affichés, de Novembre/97 à Janvier/98 et les en-têtes de colonnes correspondent à ce qui est demandé.

Image non disponible

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.

Image non disponible


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:

Image non disponible

Et en mode Feuille de données:

Image non disponible

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".
Image non disponible

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

Image non disponible

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é.

Image non disponible


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.

 
Sélectionnez

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:

Image non disponible

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:

 
Sélectionnez

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 Sub

II-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: http://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".

Image non disponible

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".

Image non disponible

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.
.

Image non disponible

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.

Image non disponible

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:

 
Sélectionnez

 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:

Image non disponible

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.

 
Sélectionnez
				
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				
II-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.

 
Sélectionnez
				
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:

Image non disponible
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.
 
Sélectionnez

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:

Image non disponible
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.

 
Sélectionnez
	
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.

 
Sélectionnez
	
    '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.

 
Sélectionnez
	
    '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.

 
Sélectionnez
	     
    '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é:

 
Sélectionnez

    '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.

 
Sélectionnez

        '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

        DoEvents

Si nous n'avions pas transformé notre format de date de critère en format européen, et si nous avions mis :

 
Sélectionnez

        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#.

Image non disponible



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.

 
Sélectionnez

        '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".

 
Sélectionnez

        '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:

 
Sélectionnez
							
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 Function

III. 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" ....

Image non disponible


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.

 
Sélectionnez
	
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 Sub

IV. 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"

 
Sélectionnez

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"

 
Sélectionnez

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 Sub

V. 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:

 
Sélectionnez


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 Sub

VI. 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

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

  

Copyright © 2009 Jean-Damien GAYOT. Aucune reproduction, même partielle, ne peut être faite de ce site et 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.