Module de classe formulaire Access

Date de publication : 15/10/2004 , Date de mise à jour : 15/10/2004

les modules de classe ont tendance à rebuter les développeurs néophytes. Qu'est-ce que c'est ? A quoi cela sert-il ? Voilà bien des questions qui sont souvent posée. Peut-être est-ce même votre cas. Après avoir pris le temps de rappeler quelques concepts de base, je vous propose de vous essayer aux modules de classe, en partant des modules de classe de formulaires Access. Vous obtiendrez des résultats très intéressants, amusants ou utiles. A votre charge d'adapter à vos besoins par la suite. Je vous souhaite un bon amusement !

I. Les concepts utiles
I-A. Notions de base sur les classes
I-B. Les variables - Portée, Type et Durée de vie
I-C. Rappels sur la classe Collection
II. Exemple 1 : La multiplication du formulaire
II-A. Objectif et résultat
II-A-1. A quoi cela va servir
II-A-2. De quoi vous avez besoin
II-B. Le formulaire Access
II-B-1. Propriétés du formulaire Access
II-C. Le code
II-C-1. Le code de base
II-C-1-a. Les déclarations
II-C-1-b. Les fonctions utiles
II-C-1-b-i. Réinitialisation de la collection
II-C-1-b-ii. Récupération du nombre de subalternes
II-C-1-b-iii. Création d'un nouvel objet formulaire
II-C-1-c. Sur activation d'un enregistrement
II-C-1-d. Sur clic du bouton cmdFermer
II-C-1-e. Sur clic du bouton cmdResponsable
II-C-1-f. Sur clic du bouton cmdSubalternes
II-C-2. Le code complet
II-D. Téléchargement
III. Exemple 2 : Synchronisation de 2 formulaires par les évènements
III-A. Objectif et résultat
III-B. Les Formulaires
III-B-1. Préparation pour les données
III-B-2. Le formulaire des employés
III-B-3. Le formulaire du graphique
III-C. Le code
III-C-1. Déclaration de l'évènement
III-C-2. Sur activation d'un enregistrement
III-C-3. Sur ouverture du formulaire

I. Les concepts utiles

I-A. Notions de base sur les classes

Comme promis, nous allons rapidement aborder la notion de classe.

La programmation en VBA cherche à se rapprocher de la programmation objet(POO = Programmation Orientée Objet), même s'il s'agit en fait plus d'une Programmation Orientée Type (POT :) ). Mais ceci est un autre débat.

Puisque nous cherchons, en VBA, à nous rapprocher de la notion physique de l'objet, partons d'un exemple physique très connu : le téléphone portable...

Cet objet (élément que nous manipulons) a des caractéristiques (que nous appelerons propriétés) qui sont, systématiquement des valeurs. Il est également possible d'exercer des actions sur l'objet (ces 'actions' sont les méthodes). Enfin, un évènement peut toujours survenir, évènement que nous pourrons intercepter pour déclencher une action que nous programmerons (lorsqu'on reçoit un appel, on peut déclencher une sonnerie différente en fonction du carnet dans lequel se trouve le numéro appelant, par exemple).

La classe correspond au 'plan', au 'cahier des charges' qui permet la réalisation de cet objet, ainsi que de tous ceux qui sont construits en suivant les principes qu'il décrit.

Régulièrement, nous créons des objets, issus des classes. En voici un exemple très simple:

Déclaration et affectation d'une variable objet

'demande à l'interpréteur la création d'une variable objet issue de la classe Recordset de la bibliothèque DAO
Dim rstClient As DAO.Recordset
'création de l'objet Recordset, et affectation à la variable
Set rstClient = CurrentDB().OpenRecordset("tblClients")
'exécution d'une action (méthode) de déplacement sur l'objet
rstClient.MoveLast
'demande de la valeur d'une caractéristique(propriété = valeur) de l'objet
MsgBox rstClient.RecordCount
'...

Vous noterez à travers cet exemple, que vous ne manipulez pas 'Recordset' qui est la classe, le modèle de tous les recordsets, mais l'objet recordset représenté par la variable rstClient. Il en est de même dans la vie courante : pour téléphoner, vous n'utilisez pas le cahier des charges, mais bien le téléphone qui a été créé d'après le cahier des charges.

Prenons l'exemple d'un formulaire Access. Il a des propriétés qui sont définies, que vous pouvez modifier. il y a également des évènements que vous pouvez intercepter pour programmer les actions que vous souhaitez entreprendre lorsque cet évènement ce produit. Nous sommes donc bien en présence d'une classe, qui permet la génération d'un nouvel objet dès que vous l'ouvrez.

I-B. Les variables - Portée, Type et Durée de vie

Voilà une partie que tout le monde devrait connaître, mais un petit rappel est peut-être utile... alors, allons-y. Premièrement, le concept de base de la déclaration d'une variable :

{Dim|Private|Public|Static} NomVariable As NomDuType

NomDuType :Comme son nom l'indique, il s'agit du nom du type de la variable. Une variable de donnée aura un type de données (String, Byte, Integer, Long, Single, Double, Decimal, Currency, Date, Boolean), alors qu'une variable de type objet recevra un nom de classe (Workspace, Database, Recordset, Field, Form, Report, ...)

{Dim|Private|Public|Static} : suivant le terme que vous utiliserez, et l'endroit où vous l'inscrirez, différents éléments seront affectés : la portée et la durée de vie. De quoi s'agit-il ?

La Portée : Cela correspond à la 'visibilité' de la variable, à son accessibilité. Si je souhaite qu'une variable ne soit accessible qu'à l'intérieur d'une procédure, et qu'une autre soit partagée entre plusieurs procédures, elles auront des portées différentes. On distingue essentiellement 4 portées : Publique, Projet, Module et Procédure.

La Durée de Vie : Cette information permet de savoir pendant combien de temps on a accès à la valeur contenue dans la variable. On pourrait ainsi décider qu'une fois qu'une procédure est terminée, une variable doit être réinitialisée, et qu'une autre doit conserver sa valeur jusqu'au prochain appel de la procédure. Ces 2 variables ont donc des durées de vie différentes.

Illustrons tous les cas(1) :

Durée de Vie/Portée	Déclaration dans la procédure	Déclaration en tête de module (avant la première procédure)
DIM	Procédure / Procédure	Projet / Module
PRIVATE	--Interdit--	Projet / Module
STATIC	Projet / Procédure	--Interdit--
PUBLIC	--Interdit--	Projet / Publique

Donnons une explication sur le mode de lecture de ce tableau :

Une variable déclarée avec Dim en tête de module sera interrogeable/modifiable uniquement par une procédure du module où elle est déclarée, et sera disponible aussi longtemps que le sera le projet (que la base sera ouverte). Elle sera par contre invisible pour toutes les procédures issues d'autres modules (au sens large du terme, soit 'module standard', 'module de classe', 'module de classe formulaire', 'module de classe état', ...)

I-C. Rappels sur la classe Collection

La bibliothèque VBA (Outils/Références...) que vous pourrez parcourir grâce à l'explorateur d'objets (F2), contient quelques classes, dont une classe 'Collection'. Cette classe permet d'accéder à des objets conteneurs, susceptible de regrouper et gérer maints élements distincts, le tout avec seulement quatre méthodes :

Add : permet d'ajouter un élément à l'objet collection

Count : renvoit le nombre d'éléments dans l'objet collection

Item : renvoie un élément de l'objet collection

Remove : supprime un élément de l'objet collection

II. Exemple 1 : La multiplication du formulaire

II-A. Objectif et résultat

II-A-1. A quoi cela va servir

L'objet de cet exercice est de construire un formulaire Access permettant la visualisation d'un employé, et d'ouvrir autant de formulaires Access identiques que de subalternes. Vous devriez également, à partir du même formulaire, pouvoir afficher le responsable de ce même employé... s'il en a un !

Pour parvenir à ce résultat, il va falloir réussir à concevoir le formulaire comme un module de classe, et non comme un objet, ce qui n'est pas exact.

Nous pourrons ensuite modifier chaque objet formulaire issus de cette classe, et cela nous donnera, par exemple, le résultat ci-dessous :

II-A-2. De quoi vous avez besoin

Pour réaliser notre objectif, il vous faut un formulaire Access, et la table 'Employés' que vous trouverez dans la base 'comptoir.mdb', sur votre poste de travail (installée avec Access)

Rien d'autre... et pourtant, vous allez pouvoir afficher une grande quantité de formulaires.

II-B. Le formulaire Access

Il suffit de créer un formulaire Access, basé sur la table employés. Ici, je n'ai gardé que quelques champs. Mais rien ne vous empêche de tous les mettre.

Prévoir également 3 boutons cmdResponsable, cmdSubalternes et cmdFermer

II-B-1. Propriétés du formulaire Access

Commençons par configurer correctement notre formulaire Access, que nous enregistrerons sous ce nom : frmEmployes_Responsables. Affichez les propriétés du formulaire Access, et définissez-les comme suit :

Nom de la propriété	Valeur
Légende	Employé d'origine ...
Barre défilement	Aucune
Afficher sélecteur	Non
Boutons déplacement	Non
Diviseurs d'enregistrement	Non
Taille ajustée	Oui
Auto centré	Oui
Style bordure	Trait double fixe
Boîte contrôle	Non
Boutons MinMax	Aucun
Bouton Fermer	Non
Modif Autorisée	Non
Suppr Autorisée	Non
Ajout Autorisé	Non
Type Recordset	Instantané
Fen Indépendante	Oui

II-C. Le code

II-C-1. Le code de base

II-C-1-a. Les déclarations

Option Compare Database
Option Explicit
'===== VARIABLES (Portée Module)
'Variable pour l'objet formulaire du responsable de l'employé
Private frmResp         As Form_frmEmployes_Responsables
'Variable pour l'objet collection regroupant les formulaires subalternes
Private colSubs         As New Collection

'===== CONSTANTES (portée Module)
'SQL pour la récupération des subalternes
Const SQL1      As String = "SELECT E.[N° employé], Count(S.[N° employé]) AS NB FROM Employés" &amp; _
                            "AS E LEFT JOIN Employés AS S ON E.[N° employé] = S.[Rend compte à] " &amp; _
                            "WHERE (((E.[Rend compte à])="
Const SQL2      As String = " GROUP BY E.[N° employé];"
'Nom de l'application
Const APPNAME   As String = "Form - Module de classe"

'==== ENUMERATION (portée Module)
'les 2 types de formulaires. Permet de définir la couleur de fond du formulaire
Enum mhTypeEmpl
    mhTypeEmplResponsable = vbBlue
    mhTypeEmplSubalterne = vbMagenta
End Enum

II-C-1-b. Les fonctions utiles

II-C-1-b-i. Réinitialisation de la collection

Private Function ClearCol() As Boolean
'---------------------------------------------------------------------------------------
' Procedure : ClearCol
' Créée le  : samedi 16 oct 2004 15:14
' Auteur    : Maxence
' Objet     : Fonction pour effacer le contenu de la collection
'---------------------------------------------------------------------------------------
'
    On Error GoTo GestErr
    Dim i   As Long
	'Si la collection n'est pas vide
    If Not colSubs.Count = 0 Then
    	'Autant de fois qu'il y a d'éléments dans la collection
        For i = colSubs.Count To 1 Step -1
        	'Retirer l'élément
            colSubs.Remove i
        Next
    End If

Finprog:
    On Error Resume Next
    Exit Function
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Function

II-C-1-b-ii. Récupération du nombre de subalternes

Private Function nbSubalternes() As Long
'---------------------------------------------------------------------------------------
' Procedure : nbSubalternes
' Créée le  : jeudi 14 oct 2004 15:38
' Auteur    : Maxence
' Objet     : Permet de définir le nombre de subalternes pour l'employé
'               En cours. Initialise rstSubalternes si possible.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
	'Variable pour l'objet Recordset contenant les subalternes
	Dim rstSubalternes  As DAO.Recordset
	
	'Réinitialisation du recordset
    Set rstSubalternes = Nothing
    
    'S'il y a un n° employé 
    If Nz(Me.N°_employé, "") = "" Then
        nbSubalternes = 0
    Else
    	'Recréer la liste des employés subalternes
        Set rstSubalternes = CurrentDb.OpenRecordset(SQL1 &amp; Me.N°_employé &amp; _
							SQL2, dbOpenSnapshot)
        'Si aucun employé n'a été trouvé
        If rstSubalternes.EOF Then
            'Renvoyer 0
            nbSubalternes = 0
        Else
        	'Sinon, renvoyer le nombre d'enregistrement de la liste.
            rstSubalternes.MoveLast
            nbSubalternes = rstSubalternes.RecordCount
        End If
    End If

Finprog:
    On Error Resume Next
    Exit Function
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Function

II-C-1-b-iii. Création d'un nouvel objet formulaire

Private Function GetNewForm(ByVal Titre As String, IDEmployé As Long, TypeEmpl As mhTypeEmpl) As Form
'---------------------------------------------------------------------------------------
' Procedure : GetNewForm
' Créée le  : vendredi 15 oct 2004 21:22
' Auteur    : Maxence
' Objet     : Génération d'un nouveau formulaire
' Arguments :
'           Titre (String)        : Titre du formulaire
'           IDEmployé (Long)      : N° de l'employé à afficher
'           TypeEmpl (mhTypeEmpl) : mhTypeEmplResponsable s'il s'agit d'un responsable
'                                   mhTypeEmplSubalterne s'il s'agit d'un subalterne
'                                   sert à définir la couleur de fond du nouveau formulaire
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    Dim f As Form_frmEmployes_Responsables

    'Définition de la variable comme  nouvel objet issu de la classe du formulaire
    Set f = New Form_frmEmployes_Responsables
    'Définition de l'objet
    With f
        'Titre du formulaire
        .Caption = Titre
        'Filtrage
        .Filter = "[N° Employé]=" &amp; IDEmployé
        .FilterOn = True
        'Couleur de fond
        .Détail.BackColor = TypeEmpl
        'Boutons de navigation
        .NavigationButtons = False
        'Oter le bouton du responsable si on est un subalterne
        If TypeEmpl = mhTypeEmplSubalterne Then .cmdResponsable.Enabled = False
        'Afficher
        .Visible = True
    End With
    'Renvoyer le formulaire
    Set GetNewForm = f

Finprog:
    On Error Resume Next
    Exit Function
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Function

II-C-1-c. Sur activation d'un enregistrement

Private Sub Form_Current()
'---------------------------------------------------------------------------------------
' Procedure : Form_Current
' Créée le  : jeudi 14 oct 2004 15:39
' Auteur    : Maxence
' Objet     : Mise à jour de l'écran au chargement d'un enregistrement.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    
    'Activation/Désactivation des boutons Responsables/Subalternes
    cmdResponsable.Enabled = Nz(Me.Rend_compte_à, "") <> ""
    cmdSubalternes.Enabled = nbSubalternes <> 0
    'Réinitialisation de l'objet du formulaire des responsables
    Set frmResp = Nothing
    'Réinitialisation de l'object collection des formulaires subalternes
    ClearCol

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Sub

II-C-1-d. Sur clic du bouton cmdFermer

Private Sub cmdFermer_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdFermer_Click
' Créée le  : jeudi 14 oct 2004 15:00
' Auteur    : Maxence
' Objet     : fermer le formulaire
'---------------------------------------------------------------------------------------
    DoCmd.Close acForm, Me.Name
End Sub

II-C-1-e. Sur clic du bouton cmdResponsable

Private Sub cmdResponsable_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdResponsable_Click
' Créée le  : jeudi 14 oct 2004 15:07
' Auteur    : Maxence
' Objet     : Ouvre un nouveau formulaire pour le responsable en cours.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr

    Set frmResp = GetNewForm("Responsable de " &amp; Me.Prénom &amp; " " &amp; _
								Me.Nom, Me.Rend_compte_à, mhTypeEmplResponsable)

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
            ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
            "du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
            "ERREUR INATTENDUE"
    Resume Finprog
End Sub

II-C-1-f. Sur clic du bouton cmdSubalternes

Private Sub cmdSubalternes_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdSubalternes_Click
' Créée le  : jeudi 14 oct 2004 17:34
' Auteur    : Maxence
' Objet     : Ouvre un nouveau formulaire par subalterne.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    Dim rs  As DAO.Recordset

    'trouver tous les Employés subalternes à l'employé en cours
    Set rs = CurrentDb.OpenRecordset("SELECT [N° Employé] FROM Employés WHERE [Rend Compte à]=" &amp; _
											Me.N°_employé, dbOpenSnapshot)
    'Effacer les formulaires actuellement dans la collection
    ClearCol
    'Créer autant de formulaires que de subalternes
    Do Until rs.EOF
        colSubs.Add GetNewForm("Subalterne de " &amp; Me.Prénom &amp; " " &amp; Me.Nom, rs(0), mhTypeEmplSubalterne)
        rs.MoveNext
    Loop

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
            ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
            "du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
            "ERREUR INATTENDUE"
    Resume Finprog
End Sub

II-C-2. Le code complet

'---------------------------------------------------------------------------------------
' Module    : Form_frmEmployes_Responsables
' Créé le   : samedi 16 oct 2004 15:14
' Auteur    : Maxence
' Objet     : Code exemple pour l'article sur la multiplication des formulaires.
'
' Licence   : Vous pouvez utiliser tout ou partie de ce code à la condition de prendre
'             soin de notifier son origine (http://mhubiche.developpez.com) et son auteur
'             (Maxence Hubiche). Merci !
'---------------------------------------------------------------------------------------
Option Compare Database
Option Explicit
'===== VARIABLES (Portée Module)
'Variable pour l'objet formulaire du responsable de l'employé
Private frmResp         As Form_frmEmployes_Responsables
'Variable pour l'objet collection regroupant les formulaires subalternes
Private colSubs         As New Collection

'===== CONSTANTES (portée Module)
'SQL pour la récupération des subalternes
Const SQL1      As String = "SELECT E.[N° employé], Count(S.[N° employé]) AS NB FROM Employés" &amp; _
                            "AS E LEFT JOIN Employés AS S ON E.[N° employé] = S.[Rend compte à] " &amp; _
                            "WHERE (((E.[Rend compte à])="
Const SQL2      As String = ")) GROUP BY E.[N° employé];"
'Nom de l'application
Const APPNAME   As String = "Form - Module de classe"

'==== ENUMERATION (portée Module)
'les 2 types de formulaires. Permet de définir la couleur de fond du formulaire
Enum mhTypeEmpl
    mhTypeEmplResponsable = vbBlue
    mhTypeEmplSubalterne = vbMagenta
End Enum

Private Sub cmdFermer_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdFermer_Click
' Créée le  : jeudi 14 oct 2004 15:00
' Auteur    : Maxence
' Objet     : fermer le formulaire
'---------------------------------------------------------------------------------------
    DoCmd.Close acForm, Me.Name
End Sub

Private Sub cmdResponsable_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdResponsable_Click
' Créée le  : jeudi 14 oct 2004 15:07
' Auteur    : Maxence
' Objet     : Ouvre un nouveau formulaire pour le responsable en cours.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr

    Set frmResp = GetNewForm("Responsable de " &amp; Me.Prénom &amp; " " &amp; _
								Me.Nom, Me.Rend_compte_à, mhTypeEmplResponsable)

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Sub

Private Sub cmdSubalternes_Click()
'---------------------------------------------------------------------------------------
' Procedure : cmdSubalternes_Click
' Créée le  : jeudi 14 oct 2004 17:34
' Auteur    : Maxence
' Objet     : Ouvre un nouveau formulaire par subalterne.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    Dim rs  As DAO.Recordset

    Set rs = CurrentDb.OpenRecordset("SELECT [N° Employé] FROM Employés WHERE [Rend Compte à]=" &amp; _
										Me.N°_employé, dbOpenSnapshot)
    ClearCol
    Do Until rs.EOF
        colSubs.Add GetNewForm("Subalterne de " &amp; Me.Prénom &amp; " " &amp; Me.Nom, _
								rs(0), mhTypeEmplSubalterne)
        rs.MoveNext
    Loop

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Sub

Private Sub Form_Current()
'---------------------------------------------------------------------------------------
' Procedure : Form_Current
' Créée le  : jeudi 14 oct 2004 15:39
' Auteur    : Maxence
' Objet     : Mise à jour de l'écran au chargement d'un enregistrement.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    
    'Activation/Désactivation des boutons Responsables/Subalternes
    cmdResponsable.Enabled = Nz(Me.Rend_compte_à, "") <> ""
    cmdSubalternes.Enabled = nbSubalternes <> 0
    'Réinitialisation de l'objet du formulaire des responsables
    Set frmResp = Nothing
    'Réinitialisation de l'object collection des formulaires subalternes
    ClearCol

Finprog:
    On Error Resume Next
    Exit Sub
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Sub


Private Function nbSubalternes() As Long
'---------------------------------------------------------------------------------------
' Procedure : nbSubalternes
' Créée le  : jeudi 14 oct 2004 15:38
' Auteur    : Maxence
' Objet     : Permet de définir le nombre de subalternes pour l'employé
'               En cours. Initialise rstSubalternes si possible.
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    'Variable pour l'objet Recordset contenant les subalternes
    Dim rstSubalternes  As DAO.Recordset
    
    'Réinitialisation du recordset
    Set rstSubalternes = Nothing
    
    'S'il y a un n° employé
    If Nz(Me.N°_employé, "") = "" Then
        nbSubalternes = 0
    Else
        'Recréer la liste des employés subalternes
        Set rstSubalternes = CurrentDb.OpenRecordset(SQL1 &amp; Me.N°_employé &amp;  _
							SQL2, dbOpenSnapshot)
        'Si aucun employé n'a été trouvé
        If rstSubalternes.EOF Then
            'Renvoyer 0
            nbSubalternes = 0
        Else
            'Sinon, renvoyer le nombre d'enregistrement de la liste.
            rstSubalternes.MoveLast
            nbSubalternes = rstSubalternes.RecordCount
        End If
    End If

Finprog:
    On Error Resume Next
    Exit Function
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Function

Private Function GetNewForm(ByVal Titre As String, IDEmployé As Long, TypeEmpl As mhTypeEmpl) As Form
'---------------------------------------------------------------------------------------
' Procedure : GetNewForm
' Créée le  : vendredi 15 oct 2004 21:22
' Auteur    : Maxence
' Objet     : Génération d'un nouveau formulaire
' Arguments :
'           Titre (String)        : Titre du formulaire
'           IDEmployé (Long)      : N° de l'employé à afficher
'           TypeEmpl (mhTypeEmpl) : mhTypeEmplResponsable s'il s'agit d'un responsable
'                                   mhTypeEmplSubalterne s'il s'agit d'un subalterne
'                                   sert à définir la couleur de fond du nouveau formulaire
'---------------------------------------------------------------------------------------
    On Error GoTo GestErr
    Dim f As Form_frmEmployes_Responsables

    'Définition de la variable comme  nouvel objet issu de la classe du formulaire
    Set f = New Form_frmEmployes_Responsables
    'Définition de l'objet
    With f
        'Titre du formulaire
        .Caption = Titre
        'Filtrage
        .Filter = "[N° Employé]=" &amp; IDEmployé
        .FilterOn = True
        'Couleur de fond
        .Détail.BackColor = TypeEmpl
        'Boutons de navigation
        .NavigationButtons = False
        'Oter le bouton du responsable si on est un subalterne
        If TypeEmpl = mhTypeEmplSubalterne Then .cmdResponsable.Enabled = False
        'Afficher
        .Visible = True
    End With
    'Renvoyer le formulaire
    Set GetNewForm = f

Finprog:
    On Error Resume Next
    Exit Function
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Function

Private Function ClearCol() As Boolean
'---------------------------------------------------------------------------------------
' Procedure : ClearCol
' Créée le  : samedi 16 oct 2004 15:14
' Auteur    : Maxence
' Objet     : Fonction pour effacer le contenu de la collection
'---------------------------------------------------------------------------------------
'
    On Error GoTo GestErr
    Dim i   As Long
    'Si la collection n'est pas vide
    If Not colSubs.Count = 0 Then
        'Autant de fois qu'il y a d'éléments dans la collection
        For i = colSubs.Count To 1 Step -1
            'Retirer l'élément
            colSubs.Remove i
        Next
    End If

Finprog:
    On Error Resume Next
    Exit Function
GestErr:
    MsgBox "Une erreur (N° " &amp; Err.Number &amp; " - " &amp; Err.Description &amp; _
	        ") a eu lieu de manière inattendue dans la procédure GetNewForm " &amp; _
			"du module Document VBA Form_frmEmployes_Responsables", vbCritical, _
			"ERREUR INATTENDUE"
    Resume Finprog
End Function

II-D. Téléchargement

Vous pouvez télécharger une base d'exemple ici (ZIP / Ko)

III. Exemple 2 : Synchronisation de 2 formulaires par les évènements

III-A. Objectif et résultat

On a souvent besoin de maintenir une synchronisation entre 2 formulaires

Comment pourrions nous imaginer cette synchronisation ? Eh bien, par exemple, si à chaque changement d'enregistrement un évènement était déclenché, il suffirait de définir un objet issu de la classe du dit formulaire, et de récupérer cet évènement !

Voilà ce que nous allons réussir à faire : Toujours en rapport avec la base de données exemple livrée avec Access, la base comptoirs, nous allons faire un formulaire pour lister les clients. à chaque changement de client, un graphique se mettra à jour dans un autre formulaire.

Tout le code qui est généré est développé sur une version 2003 d'Access. il est tout à fait probable que certaines méthodes ou propriétés utilisées soient inexistantes dans une version antérieure de l'application (Merci à Fred.G pour son test sur version XP qui a parfaitement fonctionné. Les vesions 2000 et ultérieur ne contiennent effectivement pas certaines méthodes utilisées dans la procédure 'Deplacer'.

III-B. Les Formulaires

III-B-1. Préparation pour les données

Nous allons avoir besoin de préparer les données visibles dans les formulaires et graphiques. Je vous demanderai donc de créer trois petites requêtes, dont voici le SQL :

Créer une requête qryTotalParLigne

SELECT [Détails commandes].[N° commande], [Détails commandes].[Réf produit], [Détails commandes].[Prix unitaire], 
[Détails commandes].Quantité, [Détails commandes].[Remise (%)], 
Round([Prix unitaire]*[Quantité]*(1-[Remise (%)]),2) AS TotalLigne
FROM [Détails commandes];

Créer une requête qryTotalDesLignesParCommande

SELECT qryTotalParLigne.[N° commande], Sum(qryTotalParLigne.TotalLigne) AS TotalLignes
FROM qryTotalParLigne
GROUP BY qryTotalParLigne.[N° commande];

Créer une requête qryTotalParCde

SELECT Commandes.[N° commande], Commandes.[N° employé], Commandes.[Date commande], 
qryTotalDesLignesParCommande.TotalLignes, Commandes.Port, [TotalLignes]+[port] AS TotalCde
FROM qryTotalDesLignesParCommande INNER JOIN Commandes 
ON qryTotalDesLignesParCommande.[N° commande] = Commandes.[N° commande];

La requête qryTotalParCde servira de source à notre graphiques.

III-B-2. Le formulaire des employés

La création de ce formulaire est extrêmement simple. Vous pouvez même vous servir de l'assistant si vous le voulez. En effet, il suffit d'afficher quelques informations relatives aux employés (par exemple, le nom, le prénom, la photo, etc.) Par contre, comme dans l'exemple précédent, il faudra utiliser quelques propriétés du formulaire afin d'arriver à une présentation de qualité. En voici le détail :

Nom de la propriété	Valeur
Légende	Résultats des Employé
Barre défilement	Aucune
Afficher sélecteur	Non
Boutons déplacement	Non
Diviseurs d'enregistrement	Non
Taille ajustée	Oui
Auto centré	Oui
Style bordure	Trait double fixe
Boutons MinMax	Aucun
Bouton Fermer	Oui
Fen Indépendante	Oui

Vous constatez qu'il n'y a rien de bien particulier !

III-B-3. Le formulaire du graphique

III-C. Le code

III-C-1. Déclaration de l'évènement

III-C-2. Sur activation d'un enregistrement

III-C-3. Sur ouverture du formulaire

(1)	je ne traite ici que des cas décrits dans la déclaration type donnée dans le cours. Je n'aborde pas la déclaration en Friend...

Copyright © 15/10/2004 Maxence Hubiche. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.