I. Le résultat▲
I-1. 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.
I-2. 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.
Cela nécessitera un petit passage par l'explication de la notion de module de classe. Explication rapide, car, il n'y a pas lieu de faire tout un article à ce sujet dans ce chapitre.
II. Le formulaire Access▲
Il suffit de créer un formulaire Access, basé sur la table employé. 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-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 |
III. Le code▲
III-1. Les concepts utiles▲
III-1-a. Notions de base sur les classe▲
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:
'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.
III-1-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', ...)
III-1-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, sont 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
III-2. Le code de base▲
III-2-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"
&
_
"AS E LEFT JOIN Employés AS S ON E.[N° employé] = S.[Rend compte à] "
&
_
"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
III-2-b. Les fonctions utiles▲
III-2-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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Function
III-2-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 &
Me.N
°_employé &
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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Function
III-2-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é]="
&
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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Function
III-2-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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Sub
III-2-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
III-2-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 "
&
Me.Prénom
&
" "
&
Me.Nom
, Me.Rend_compte_à
, mhTypeEmplResponsable)
Finprog
:
On
Error
Resume
Next
Exit
Sub
GestErr
:
MsgBox
"Une erreur (N° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Sub
III-2-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 à]="
&
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 "
&
Me.Prénom
&
" "
&
Me.Nom
, rs
(
0
), mhTypeEmplSubalterne)
rs.MoveNext
Loop
Finprog
:
On
Error
Resume
Next
Exit
Sub
GestErr
:
MsgBox
"Une erreur (N° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Sub
III-3. 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"
&
_
"AS E LEFT JOIN Employés AS S ON E.[N° employé] = S.[Rend compte à] "
&
_
"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 "
&
Me.Prénom
&
" "
&
Me.Nom
, Me.Rend_compte_à
, mhTypeEmplResponsable)
Finprog
:
On
Error
Resume
Next
Exit
Sub
GestErr
:
MsgBox
"Une erreur (N° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"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 à]="
&
Me.N
°_employé, dbOpenSnapshot)
ClearCol
Do
Until
rs.EOF
colSubs.Add
GetNewForm
(
"Subalterne de "
&
Me.Prénom
&
" "
&
Me.Nom
, rs
(
0
), mhTypeEmplSubalterne)
rs.MoveNext
Loop
Finprog
:
On
Error
Resume
Next
Exit
Sub
GestErr
:
MsgBox
"Une erreur (N° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"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 &
Me.N
°_employé &
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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"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é]="
&
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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"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° "
&
Err
.Number
&
" - "
&
Err
.Description
&
_
") a eu lieu de manière inattendue dans la procédure GetNewForm "
&
_
"du module Document VBA Form_frmEmployes_Responsables"
, vbCritical
, _
"ERREUR INATTENDUE"
Resume
Finprog
End
Function
IV. Téléchargement▲
Vous pouvez télécharger une base d'exemple ici (ZIP / Ko)