informer

Objectif

J'ai un formulaire avec X boutons qui tous appellent la même fonction sous l’événement

• OnClick -> la fonction appelée a comme paramètre le nom du bouton

Je veux éviter la déclaration de l'événements Click pour chaque bouton

Contexte

Table
TableInfos

Formulaire

• 2 formulaires
  
  • frmXA
    
    • De 2 boutons (XA, XB)
    • D’une zone de texte (txtTableName)
    
    
  • frmXB -> même structure que frmXA mais boutons différents
  
  
• Un formulaire Navigation (frmNavMain) composé de 2 onglets
  
  • Table X composé de
    
    • formulaire frmXA
    
    
  • Tables B composé de
    
    • formulaire frmXB
    
    
  
  

Code

Création du module de classe clsCtlCmdBtn

Ajouter un module de classe nommé clsCtlCmdBtn et copier/coller les code suivant

Déclaration globale à la classe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Option Compare Database
Option Explicit

Dim WithEvents ctlBtn As CommandButton
Const cnEvProc As String = "[Event Procedure]" 'Pour l’activation de l’évenement

• setInstanceBtn (pBtn As CommandButton)
• Attribue la référence du bouton passé en paramètre au bouton de la classe -> Set ctlBtn = pBtn
• Implémente l'événement OnClick. Pour implémenter plusieurs événements faire autant de déclarations de type ctlBtn.OnEvent = cnEvProc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Function setInstanceBtn (pBtn As CommandButton)
    Set ctlBtn = pBtn
    MsgBox "Init the class for: " & ctlBtn.Name
    ctlBtn.OnClick = cnEvProc 'Pour activer l’évenement
End Function

• Class_Terminate
• Destructeur de la classe -> Déclaration doit toujours respecter cette écriture donc toujours écrire Class_Terminate
• Appelé quand l'instance de la classe est dissociée du bouton réel du formulaire -> Cf. Private Sub Form_Close() Set oBtnXA = Nothing ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Class_Terminate()
MsgBox "unload class for: " & ctlBtn.Name
Set ctlBtn = Nothing
End Sub

• ctlBtn_Click
• Attribution des traitements sous l'événement OnClick déclaré dans SetInstanceBtn
• Attention bien déclarer l'appel de l'événement avec ses paramètres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Private Sub ctlBtn_Click(Cancel As Integer)
    Call fGetData(ctlBtn)
End Sub

• fGetData
• Fonction propre à la classe qui alimente un champ texte du formulaire dans lequel se trouve le bouton
• Pour accéder au formulaire dans lequel est déclaré le bouton, utiliser pCtlBtn.Parent

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Function fGetData(pCtlBtn As CommandButton)
    Dim db As DAO.Database
    Dim oRSet As DAO.Recordset
    Dim sSQL As String
    Dim Info, Titre, TitreLst As String, sTableCode As String

On Error GoTo Err_
    sTableCode = pCtlBtn.Name
    Set db = Application.CurrentDb
    pCtlBtn.Parent.txtTableName = pCtlBtn.Name 
    
    sSQL = "SELECT * FROM TableInfo WHERE tableCode = '" & sTableCode & "'"
    Set oRSet = db.OpenRecordset(sSQL)
    With oRSet
        If oRSet.EOF = False Then
            pCtlBtn.Parent.txtTableName = pCtlBtn.Parent.txtTableName & vbCrLf & Nz(.Fields("tableTitle")) & vbCrLf & Nz(.Fields("tableTitleFr"))
        End If
    End With
Exit_:
    oRSet.Close :
    db.Close
    Exit Function
Err_:
    MsgBox Err.Number & Chr(13) & Err.Description
    GoTo Exit_
End Function

Dans formulaire frmXA

Copier le code ci-dessous

• Déclaration globale au formulaire
• Instanciation des classes, une par objet (Ici 2)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Option Compare Database
Option Explicit

Private oBtnXA As New clsCtlCmdBtn
Private oBtnXB As New clsCtlCmdBtn

• Form_Close
• Destruction des classes -> Appel de son destructeur Class_Terminate

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Form_Close()

Set oBtnXA = Nothing
Set oBtnXB = Nothing

End Sub

• Form_Load
• Attribution des boutons aux classes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Form_Load()
    
    '---------------------------------------------------------
    ' Fait pointer l'objet instancier sur le bouton
    '--------------------------------------------------------
    oBtnXA.setInstanceBtn Me.XA
    oBtnXB.setInstanceBtn Me.XB
   
End Sub