Créez des formulaires de dialogue avec acDialog et sans variable globale [Trucs & Astuces]

**Arkham46** · 16/09/2009, 16h25

Bonjour,

Pour remplacer les boîtes de dialogue MsgBox et InputBox, on peut créer des formulaires personnalisés et les ouvrir avec OpenForm et le paramètre acDialog.
Le problème est que lorsque OpenForm nous rend la main, le formulaire est fermé et ne peut pas lire le résultat.

Il y a des solutions discutables avec des variables globales ou des boucles d'attente.

Ici l'astuce consiste à rendre invisible le formulaire (Visible = False) au lieu de le fermer.
Le programme appelant reprend la main dès que le formulaire de dialogue est rendu invisible, et on peut lire le résultat avant de le fermer définitivement.

Pour mettre tout ça en pratique, insérez ce code dans le formulaire de dialogue :

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Option Compare Database
Option Explicit
 
'--------------------------------------------------------------------------------
' Formulaire dialogue
'--------------------------------------------------------------------------------
' Définissez le résultat si fermeture dans Form_Unload, à la place des XXXXXX
' Définissez les résultats avec la propriété Result (Result = LaValeur)
'--------------------------------------------------------------------------------
 
' Variable contenant le résultat
Dim lResult As Variant
 
'-------------------------------------------------
' Propriété de lecture/écriture du résultat
'-------------------------------------------------
Private Property Let Result(pResult As Variant)
' Met à jour le résultat
lResult = pResult
' Rend le formulaire invisible pour rendre la main au programme appelant
Me.Visible = False
End Property
Public Property Get Result() As Variant
Result = lResult
End Property
 
'-------------------------------------------------
' Sur fermeture du formulaire
'-------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
' Seulement si le formulaire est visible
' Sinon le formulaire doit se fermer
If Me.Visible Then
    ' Résultat si formulaire fermé
    Result = XXXXXX
    ' Annule la fermeture (le formulaire sera fermé par l'appelant)
    Cancel = True
End If
End Sub

- Remplacez les XXXXXX par le résultat à renvoyer en cas de fermeture du formulaire.
- Mettez à jour le résultat en fonction des actions sur le formulaire (click, mise à jour de contrôle, ...) avec la propriété Resultat.

L'écriture dans cette propriété redonne la main au programme appelant.
Si vous ne souhaitez pas ce comportement, retirez la ligne Me.Visible = False et insérez la à l'endroit où vous voulez redonner la main à l'appelant.

Ensuite dans le code appelant le formulaire de dialogue :
- Définissez une variable pour recevoir le résultat :

Code :

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

1
2
 
Dim lResult As Variant ' Modifier Variant par le type de données utilisé

- Ouvrez le formulaire en mode dialogue :

Code :

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

1
2
3
 
' Ouvre le formulaire en mode dialogue
DoCmd.OpenForm "MonFormulaireDialogue", , , , , acDialog

- Récupérez le résultat avec la propriété Result :

Code :

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

1
2
3
 
' Récupère le résultat lorsque le formulaire est rendu invisible
lResult = Forms("MonFormulaireDialogue").Result

- Fermez le formulaire de dialogue (il est invisible mais il faut le fermer) :

Code :

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

1
2
3
 
' Ferme le formulaire invisible
DoCmd.Close acForm, "MonFormulaireDialogue"

lResult contient le résultat.

On peut mettre ce code dans une fonction dans un module standard :

Code :

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

1
2
3
4
5
6
7
8
9
 
Public Function OpenDialogForm(pFormName As String, Optional pOpenArg As String) As Variant
' Ouvre le formulaire en mode dialogue
DoCmd.OpenForm pFormName, , , , , acDialog, pOpenArg
' Récupère le résultat lorsque le formulaire est rendu invisible
OpenDialogForm = Forms(pFormName).Result
' Ferme le formulaire invisible
DoCmd.Close acForm, pFormName
End Function

Le code appelant est alors réduit à :

Code :

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

1
2
3
4
 
Dim lResult As Variant
' Ouvre le formulaire de dialogue
lResult = OpenDialogForm("MonFormulaireDialogue")

En pièce-jointe, un petit exemple.

**micniv** · 16/09/2009, 21h56

Merci Arkham !
Je suis toujours admiratif et ... preneur de ces leçons de finesse !

**Chtulus** · 16/09/2009, 22h13

Bonsoir Arkham,

**ilank** · 17/09/2009, 01h03

Bonsoir,

une alternative utiliser un objet PILE avec deux méthodes PUSH et POP.

Maintenant pour l'objet PILE deux classes
classe ClREGISTRE

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
' ================================================================================================================================================
'|| Module     :  ClREGISTRE
'|| Créé le      : 29-05-2008
'|| Modifié le :
'|| Rôle          : Registre de pile LIFO ou FIFO et LISTE CHAINEE
'||
'||------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'||
'|| Tables          :
'|| Objets          :
'|| Formulaires  :
'|| Menus          :
' ================================================================================================================================================
Public ElementValue
Public PreviousItem As ClREGISTRE
Public NextItem As ClREGISTRE

classe ClSTACK

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
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
' ================================================================================================================================================
'|| Module     :  ClSTACK
'|| Créé le      : 29-05-2008
'|| Modifié le :
'|| Rôle          : Objet Pile de type LIFO (Last IN First Out) Dernier entré-Premier sorti
'||
'||------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'||
'|| Tables          :
'|| Objets          :
'|| Formulaires  :
'|| Menus          :
' ================================================================================================================================================
Private PtrSTACK As ClREGISTRE
Private StackSize As Long
Private SizeAllowed As Long
Const DEFAULT_STACKSIZE = 32768
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Procédure       : PUSH
'Créée le         : 02-06-2008          Modifée le :
'
'Rôle              : Place un nouvel élément dans la pile
'
' Arguments   : ENTRYVALUE : (Variant) élément à charger dans pile STCK_PILE
'
' Tables          : (aucune)
'
'  Objets         : STCK_ENTRY (Cl_StackElement)
'
' Variables      :
'
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Public Function push(ByVal EntryValue)
    Dim STCK_Entry  As ClREGISTRE
    If StackSize + Len(EntryValue) < SizeAllowed Then
        Set STCK_Entry = New ClREGISTRE
    Else
        Set STCK_Entry = PtrSTACK
    End If
 
    If IsObject(EntryValue) Then
        Set STCK_Entry.ElementValue = EntryValue
    Else
         STCK_Entry.ElementValue = EntryValue
    End If
    Set STCK_Entry.NextItem = PtrSTACK
    Set PtrSTACK = STCK_Entry
    StackSize = StackSize + Len(STCK_Entry.ElementValue)
End Function
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Fonction       : POP (Variant)
'Créée le         : 02-06-2008          Modifée le :
'
'Rôle              : Retire de la pile le dernier élément chargé
'
' Arguments   : (aucun)
'
' Tables          : (aucune)
'
'  Objets         : (aucun)
'
' Variables      :
'
'-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Public Function pop()
    Dim STCK_Entry As Object
    If (PtrSTACK Is Nothing) Then Exit Function
    Set STCK_Entry = PtrSTACK.NextItem
    If IsObject(PtrSTACK.ElementValue) Then
        Set pop = PtrSTACK.ElementValue
    Else
        pop = PtrSTACK.ElementValue
    End If
    StackSize = StackSize - Len(PtrSTACK.ElementValue)
    Set PtrSTACK = Nothing
    Set PtrSTACK = STCK_Entry
End Function
 
Private Sub Class_Initialize()
    Set PtrSTACK = Nothing
    SizeAllowed = DEFAULT_STACKSIZE
End Sub

Dans un module supplémentaire

Code :

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

1
2
3
4
5
6
7
8
9
10
Private PILE As ClSTACK
 
Public Sub push (lValeur)
 If (PILE Is Nothing) Then Set PILE=New ClSTACK
 PILE.push lValeur
End Sub
 
Public Function pop () 
 If Not (PILE Is Nothing) Then pop=PILE.pop
End Function

Le module d'Arkham

Code :

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

1
2
3
4
Public Function OpenDialogForm(pFormName as String, pOpenArg as String) As Variant
 Docmd.OpenForm FormName:=pFormName, WindowMode:=acDialog
 OpenDialogForm=pop
End function

Pour le formulaire FormDialog1

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
 
Dim lResult As Variant
'-------------------------------------------------
' Click sur bouton Yes
'-------------------------------------------------
Private Sub btnYes_Click()
lResult = vbYes
DoCmd.Close acDataForm, Form.Name
End Sub
 
'-------------------------------------------------
' Click sur bouton No
'-------------------------------------------------
Private Sub btnNo_Click()
lResult = vbNo
DoCmd.Close acDataForm, Form.Name
End Sub
 
Private Sub Form_Close()
    push lResult
End Sub
 
Private Sub Form_Load()
    lResult = vbCancel
End Sub

**nico84** · 17/09/2009, 09h10

Bonjour,

Merci, c'est clair, élégant et ça peut me servir

Il y a des solutions discutables avec des variables globales ou des boucles d'attente.

En quoi l'utilisation d'une variable globale est-elle discutable ? Y a-t-il des risques de conflit si plusieurs utilisateurs utilisent la même variable au même moment (dans le cas d'un exécutable sur le serveur) ???

**Arkham46** · 17/09/2009, 10h17

Envoyé par nico84

En quoi l'utilisation d'une variable globale est-elle discutable ? Y a-t-il des risques de conflit si plusieurs utilisateurs utilisent la même variable au même moment (dans le cas d'un exécutable sur le serveur) ???

Non pas de risque en cas d'utilisation multi-utilisateurs, les variables sont propres à l'environnement d'exécution, donc à chaque utilisateur.

Là où on peut discuter c'est que les variables globales ont une durée de vie ... globale.
C'est à dire qu'en cas d'utilisation de telles variables, il faut bien les initialiser avant chaque appel au formulaire dialogue, et même les vider ensuite si on ne veut pas qu'elles occupent de la mémoire inutilement (même si c'est souvent qu'une petite quantité de mémoire) ou soient réutilisées à tort.
Si on ajoute une variable et qu'on oublie de l'initialiser à un endroit (on peut utiliser une même variable pour plusieurs appels du formulaire) on risque le bug.
Et on se retrouve vite avec un module qui contient beaucoup de variables et il faut commenter chacune pour savoir à quoi elle sert et dans quelles fonctions elles sont utilisées.
Bien codé ça marche quand même bien.

Pour moi l'avantage de la méthode ci-dessus c'est que les variables ont automatiquement une durée de vie égale à la durée de vie du formulaire dialogue.
Et en plus on peut ajouter autant de propriétés qu'on souhaite pour faire un formulaire qui retourne plusieurs valeurs.
Tout ce qui concerne un formulaire de dialogue est intégré à ce formulaire, c'est plus facile à maintenir : pas besoin d'aller chercher des variables dans un autre module, pas besoin de parcourir toute l'appli pour penser à bien initialiser chaque variable.