Fermeture de formulaire : Comment empecher la question 'voulez vous enregistrer etc.

**ArchiSi** · 19/06/2023, 20h33

Bonjour,
Ma question va vous paraitre futile, mais je en trouve pas ...

J'ai fait un formulaire pour génerer à la colée une requete sql, qui appelle pour afficher le résultat un formulaire vide qu'il dessine et peuple en fonctio de la requete résultante. Il est donc important que ce formulaire reste vide. aussi je veux pourvoir le fermer par la petite croix en haut à droite sans qu ' access ne me demande si je veux enregistrer, nie qu'access ne l'enregistre.

Nom : sortiepar la croix.PNG
Affichages : 89
Taille : 10,1 Ko

Nom : sortiepar la croix.PNG
Affichages : 89
Taille : 10,1 Ko

j'ai bien mis un événement 'sur fermeture' mais il continue de me poser la question

Nom : sur fermeture.PNG
Affichages : 79
Taille : 10,6 Ko

Quelqu'un aurait il une solution ?

codialement,

**madefemere** · 20/06/2023, 15h22

Bonjour,

Tu ne peux pas modifier le comportement de ce bouton standard de fermeture d'un formulaire.
Il faut ajouter un bouton sur ton formulaire avant de le peupler et mettre tes desiderata dans les propriétés de ce bouton.

Cordialement.

**ArchiSi** · 20/06/2023, 15h54

ah,
D'accord.
Mais le soucis c'est qu'en mode DS (feuille de données) on ne voit pas mes boutons.
La je crois que je suis un peut coincée.
Il faut je pense developper une procedure de nettoyage du formulaire appelée à la fermeture, ou avant l'ouveture en mode creation avant le design dynamique.
J'y reflechis ...
Merci pour l'explication.
Cdlt

**ArchiSi** · 20/06/2023, 18h51

Re,
J'ai essayé d'introduire une procédure de nettoyage du formulaire.
J'ai renommé les boutons que je souhaite conserver en les préfixant de ANEPASEFFECER_
Puis j'ouvre le formulaire en mode création, pour chaque champ rencontré s'il n'a pas ce préfixe, je l'efface.
Problème il me faut trois passes pour que tous les champs soient effacer. Il y a un souci dans ma boucle, car des contrôles sont sautés. je pense qu'il se perd dans ses index lors de l'effacement d'un contrôle.
Ci-dessous le source.
Quelque aurait-il une idée sur la manière de procéder, car visiblement je ne peux pas faire en même temps une boucle pour passer en revue chaque contrôle et les effacer lorsqu'ils remplissent les critères.

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
Function NETTOIE_FORM_RECPT(sFormName As String, trcdbg As Boolean)
    Const wouca = "FORMULAIRE Fdv_RQT_ALAVOLEE  _ NETTOIE_FORM_RECPT(sFormName As String)"
    Dim textmsg As String
         Dim tobedel As Boolean
         tobedel = True
 
 
    ' OUVERTURE POUR NETTOYAGE
    Application.DoCmd.OpenForm sFormName, acDesign 'Ouverture du formulaire receptacle en mode création
    Set oFrm = Forms(sFormName)                    'Recupération du pointeur de ce formulaire receptacle
 
    For Each ctl In oFrm.Controls                 'Pour chaque contrôle du formulaire receptacle
         Select Case ctl.Name
                Case "NEPASEFFACER_BTN_ANNULER"
                tobedel = False
                Case "NEPASEFFACER_BTN_OK"
                tobedel = False
                Case "NEPASEFFACER_BTN_Export"
                tobedel = False
                Case Else    ' Other values.
                tobedel = True
         End Select
         textmsg = textmsg & Chr(13) & Chr(10) & sFormName & " . Nettoyage formulaire -> suppression du contrôle " & ctl.Name & " . tobedel " & tobedel
        If tobedel Then
             ' Efface le controle
             'Syntaxe DeleteControl frm.Name, ctl.Name
             DeleteControl sFormName, ctl.Name      ' Delete control.
        End If
    Next ctl
 
   If trcdbg Then MsgBox textmsg, vbOKOnly, wouca
 
 
  'FERMETURE APRES NETTOYAGE
  'Syntaxe: DoCmd.Close acForm, "Order Review", acSaveYes
  Application.DoCmd.Close acForm, sFormName, acSaveYes 'Fermeture du formulaire receptacle en sauvegardant
 
End Function
Private Sub ANNULER_Click()
' Application.DoCmd.Close acForm, oForm.Name, acSaveNo  'Fermeture du formulaire sans sauvegarder
End Sub
 
Private Sub Execute_Click()
    Const wouca = "FORMULAIRE Fdv_RQT_ALAVOLEE  _ [Bouton] Execute_Click"
    Dim execFonc As Boolean
    execFonc = False
 
    Dim trcdbg As Boolean
    trcdbg = True
 
    If trcdbg Then MsgBox "Demande d'execution de la requête : " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & CALCUL_GRSQL, vbOKOnly, wouca
 
    ' Appel de a fonction de nettoyage du formulaire receptacle    Fdv_RQT_ALAVOLEE_RESULT 
    execFonc = NETTOIE_FORM_RECPT("Fdv_RQT_ALAVOLEE_RESULT", trcdbg)
 
    ' Appel de la fonction  peuplant le formulaire   Fdv_RQT_ALAVOLEE_RESULT  en fonction du contenu de la requete
    execFonc = mfForm_AddControls(CALCUL_GRSQL, trcdbg)
 
    GoTo Fin
 
Err_execFonc:  'etiquette  ' gestion de l'erreur
    Dim TxtError As String
    TxtError = "_ ERR _ Sub Execute_Click() " & "  !!! " & Err.Description & " !!!"
    TxtError = TxtError & Chr(13) & Chr(10) & Chr(13) & Chr(10) & CALCUL_GRSQL
    MsgBox TxtError, vbCritical, wouca
    Resume Exit_Execute_Click ' sortie de la procédure en erreur
Exit_Execute_Click:
    'effacer les champs crés dans le formulaire commencé dans cette fonction
Fin:
 
End Sub

merci d'avance de vos retours;
cdlt

**madefemere** · 21/06/2023, 08h32

Bonjour,

Il faut utiliser la propriété Remarque (Tag en anglais) de ton bouton.
Tu la définis comme étant "ANEPASEFFACER"

Quand tu vides ton formulaire de ses contrôles, tu le fais pour TOUS sauf celui qui a comme remarque "ANEPASEFFACER"

tag <>"ANEPASEFFACER"

Cordialement

**ArchiSi** · 21/06/2023, 09h13

Ah d'accord, génial !
Merci pour l'information.

J'avais finalisé ma procédure avant de te lire.
code ci-dessous, si ca peut servir.

Je la reprends pour l'alleger avec cette astuce

On pourra perfectionner en ajoutant une analyse de la requete pour ne la soumettre que si elle est valide
mais la je vais entrer ans une usine à gaz, et c'est déjà pas mal comme cela, pour l'instant au moins

Merci beaucoup.
cdlt,

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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
Public Function mfForm_AddControls(sFormName As String, CALCUL_GRSQL As String, trcdbg As Boolean) As Boolean
 
'===================================
'Peuple mon formulaire vec le résultat de la requete SQL
'===================================
 
    Const wouca = "FORMULAIRE Fdv_RQT_ALAVOLEE  _  FONCTION mfForm_AddControls"
    Dim dbs As Database         'pour recevoir l'instance courrante de base de donnée
    Dim NBoRsetRows As Integer  'Nombre de lignes retournées par la requete
    NBoRsetRows = 0             'initialisation
 
    Dim oFrm As Form, _
        oText As Control, _
        oLabel As Control, _
        oRset As Recordset, _
        oField As Field, _
        lLeft As Long, _
        lTop As Long, _
        lWidth As Long, _
        lHight As Long, _
        i As Integer
 
    lLeft = 343
    lTop = 341
    lWidth = 2460
    lHight = 330
 
    On Error GoTo Err_Recordset
 
    'avant d'affecter la requete au nouveau formulaire verifier que la requete retourne quelque chose
    Set dbs = CurrentDb()                         'recupère l'instance de la BD courrante
    Set oRset = dbs.OpenRecordset(CALCUL_GRSQL)   'chargement de la requete
    NBoRsetRows = oRset.RecordCount               'Dénombre le nombre d'occurence satisfaisant la requete
 
    '''======================================SOURCE DESUET , remplacé par  oRset.RecordCount ======
    ''' ' Compte le nombre d'occurence satisfaisant la requete
    '''Do While Not (oRset.EOF) 'Tant que ce n'est pas la fin de fichier
    '''
    '''  'On passe ici si au moins une ligne est retournée par la requete
    '''
    '''  If ((IsNull(oRset)) Or (oRset(0) = "") Or (oRset(0) = Null) Or (IsNull(oRset(0)))) Then
    '''     'Si la requete retourne une valeur nulle
    '''     If trcdbg Then MsgBox " retourne une valeur vide ou null ...", vbOKOnly, wouca
    '''  Else
    '''     'Si la requete retourne une valeur non vide, mise à jour du champ de formulaire
    '''     'avec le résultat de cette requête
    '''     If trcdbg Then MsgBox " retourne une valeur non vide ...passage à la suite", vbOKOnly, wouca
    '''     NBoRsetRows = NBoRsetRows + 1
    '''  End If
    '''  oRset.MoveNext 'passe a l'occurence suivante
    '''Loop
    '''===================================================================fin SOURCE DESUET========
 
    If Not (NBoRsetRows > 0) Then
       MsgBox CALCUL_GRSQL & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Cette requete ne retourne aucun résultat ! ", vbOKOnly, wouca
       GoTo Fin
    Else
       If trcdbg Then MsgBox "nb de lignes correspondant à cette requete : " & CStr(NBoRsetRows), vbOKOnly, wouca
    End If
 
    'le formulaire receptacle Fdv_RQT_ALAVOLEE_RESULT existe déjà à vide
    'sFormName = "Fdv_RQT_ALAVOLEE_RESULT"   'Initialisation du nom du formulaire receptacle
    DoCmd.OpenForm sFormName, acDesign       'Ouverture du formulaire receptacle en mode création
    Set oFrm = Forms(sFormName)              'Recupération du pointeur de ce formulaire receptacle
    oFrm.RecordSource = CALCUL_GRSQL         'Affectation de la requete source au formulaire
 
    i = 0
    For Each oField In oRset.Fields
       '------------------------------------------------------------------------------------------------------------------------------------------------------
       ' Creation de l'objet texte avant celui de l'objet lablel car sera le parent du label
       '------------------------------------------------------------------------------------------------------------------------------------------------------
       ' If trcdbg Then MsgBox CStr(i) & " oText.Name = txt" & oField.Name, vbOKOnly, wouca
        Set oText = CreateControl(oFrm.Name, acTextBox, acDetail, , oField.Name, lLeft, lTop + ((lHight + 150) * i), lWidth, lHight)
        oText.Name = "txt" & oField.Name
 
       '------------------------------------------------------------------------------------------------------------------------------------------------------
       ' Creation de l'objet lablel dont le parent sera le'objet Texte
       '----------------------------------------------------------------------------------------------------------------------------------------------------
       ' If trcdbg Then MsgBox CStr(i) & " oLabel.Name = lbl" & oField.Name, vbOKOnly, wouca
        Set oLabel = CreateControl(oFrm.Name, acLabel, acDetail, oText.Name, oField.Name, lLeft + lWidth + 150, lTop + ((lHight + 150) * i), lWidth, lHight)
        oLabel.Name = "lbl" & oField.Name
 
       '------------------------------------------------------------------------------------------------------------------------------------------------------
       ' Passage au champ suivant
       '----------------------------------------------------------------------------------------------------------------------------------------------------
        i = i + 1
 
        If trcdbg Then MsgBox CStr(i) & " incrément ", vbOKOnly, wouca & "(" & sFormName & "..."
       ' oField.MoveNext '=> génère l'erreur "... non géré par cet objet"
         'oRset.MoveNext 'BAHH NON ! ce n'est pas le passage à l'enregistrement suivant qui doit être ici.
    Next oField 'VOILA ! Passage au champ suivant, fin de la boucle For each oField ...
 
 
 
    If trcdbg Then MsgBox "NB de champ correspondant à cette requête : " & CStr(i), vbOKOnly, wouca
 
    'EN TOUTE BONNE LOGIQUE IL EU FALLU FERMER LE FORMULAIRE AINSI REDESIGNE AVANT
    'DE LE REOUVRIR EN MODE DONNEES. MAIS CELA GENERE UNE ERREUR ...
    'CA FONCTIONNE SANS L'OPERATION DE FERMETURE, ON VA LAISSER COMME CELA POUR LE MOMENT
    'Close method to close the form Order Review, saving any changes to the form without prompting.
    ' Syntaxe DoCmd.Close acForm, "Order Review", acSaveYes
    'Application.DoCmd.Close acForm, sFormName, acSaveYes 'Fermeture du formulaire receptacle en sauvegardant
    ' => genere l' erreur "Argument ou appel de procédure incorrect"
    'Application.DoCmd.Close acForm, sFormName   'Fermeture du formulaire receptacle en sauvegardant
    ' => pose la question voulez vous enregistrer, puis quelque soit la réponse génère la meme erreur
 
    'Ré-Ouverture du formulaire receptacle en mode formulaire, ou tableau ... selon la valeur du radio bouton
    'Syntaxe : DoCmd.OpenForm "Nom du formulaire", type d'ouverture,"nom du filtre", "condition Where"
    If Me.RB_option1.Value Then DoCmd.OpenForm oFrm.Name, acFormDS          'Mode Data sheet (feuille de données)
    If Me.RB_option2.Value Then DoCmd.OpenForm oFrm.Name, acFormPivotTable  'Mode Tableau croisé
    If Me.RB_option3.Value Then DoCmd.OpenForm oFrm.Name, acNormal          'Mode formulaire
    If Me.RB_option4.Value Then DoCmd.OpenForm oFrm.Name, acLayout          'Mode Layout
    If Me.RB_option5.Value Then DoCmd.OpenForm oFrm.Name, acPreview         'Mode Page
    If Me.RB_option6.Value Then DoCmd.OpenForm oFrm.Name, acFormPivotChart  'Mode Pivot Chart
 
 
    'Cleanup
    oRset.Close
    Set oRset = Nothing
 
    GoTo Fin
 
Err_Recordset:  'etiquette  ' gestion de l'erreur
    Dim TxtError As String
    TxtError = "_ ERR _ Function mfForm_AddControls(CALCUL_GRSQL As String) " & "  !!! " & Err.Description & " !!!"
    TxtError = TxtError & Chr(13) & Chr(10) & Chr(13) & Chr(10) & CALCUL_GRSQL
    MsgBox TxtError, vbCritical, wouca
    Resume Exit_mfForm_AddControls ' sortie de la procédure en erreur
Exit_mfForm_AddControls:
    'prévu à developper effacer les champs crés dans le formulaire commencé dans cette fonction
    '=> ce n'est plus d'actualité car le formulaire est systématiquement vidé avant d'être peuplé
Fin:
End Function
 
Function NETTOIE_FORM_RECPT(sFormName As String, trcdbg As Boolean)
'===================================
'Vide le formulaire avant de pouvoir le peupler avec le résultat de la requete SQL
'===================================
 
    Const wouca = "FORMULAIRE Fdv_RQT_ALAVOLEE  _ NETTOIE_FORM_RECPT(sFormName As String)"
    Dim textmsg As String
    Dim tobedel As Boolean                         'indicateur doit être effacer ou non
    tobedel = True                                 'initialiser indicateur doit être effacer ou non
    Dim nbctrl As Integer                          'nombre de controles (champ, bouton, etiquette ...)
 
    ' OUVERTURE POUR NETTOYAGE
    Application.DoCmd.OpenForm sFormName, acDesign 'Ouverture du formulaire receptacle en mode création
    Set oFrm = Forms(sFormName)                    'Recupération du set de ce formulaire receptacle
    nbctrl = oFrm.Controls.Count                   'Nombre total de champ dans ce set
    textmsg = "Nb 'contrôles' du formulaire " & sFormName & ": " & CStr(nbctrl)
    If trcdbg Then MsgBox textmsg, vbOKOnly, wouca 'Trace debug
    Set ctl = oFrm.Controls                        'Chargement du set de contrôles
    textmsg = "Nb 'contrôles' du formulaire " & sFormName & ": " & CStr(nbctrl) & " . " & CStr(ctl.Count)
 
    While nbctrl > 0                               'Tant qu'il reste un contrôle, champ ou etiquette ou bouton ... à traiter
        nbctrl = nbctrl - 1                        'Décrémentation du nombre de contôle
        Select Case ctl(nbctrl).Name               'Analyse du nom du contrôle à traiter
                Case "NEPASEFFACER_BTN_ANNULER"    's'il s'agit d'un contrôle à préserver
                tobedel = False                    'gestion de l'indicateur doit être effacer ou non
                Case "NEPASEFFACER_BTN_OK"         's'il s'agit d'un contrôle à préserver
                tobedel = False                    'gestion de l'indicateur doit être effacer ou non
                Case "NEPASEFFACER_BTN_Export"     's'il s'agit d'un contrôle à préserver
                tobedel = False                    'gestion de l'indicateur doit être effacer ou non
                Case Else                          'Pour tout autre valeur, il ne s'agit pas d'un contrôle à préserver
                tobedel = True                     'gestion de l'indicateur doit être effacer ou non
         End Select                                'Fin d'analyse  du nom du contrôle à traiter
         textmsg = textmsg & Chr(13) & Chr(10) & " . Nettoyage " & CStr(nbctrl) & " -> suppression du contrôle " & ctl(nbctrl).Name & " . tobedel " & tobedel
         DeleteControl sFormName, ctl(nbctrl).Name ' Delete control.
         If trcdbg Then MsgBox textmsg, vbOKOnly, wouca 'Trace debug
         Debug.Print textmsg
    Wend
 
    If trcdbg Then MsgBox textmsg, vbOKOnly, wouca 'Trace debug
 
 
'   ==================================================================================================
'   ==SOURCE BUGGE : certains champs sont ignorés, cette boucle ne traite pas tous les champs du set==
'    For Each ctl In oFrm.Controls                 'Pour chaque contrôle du formulaire receptacle
'         Select Case ctl.Name
'                Case "NEPASEFFACER_BTN_ANNULER"
'                tobedel = False
'                Case "NEPASEFFACER_BTN_OK"
'                tobedel = False
'                Case "NEPASEFFACER_BTN_Export"
'                tobedel = False
'                Case Else    ' Other values.
'                tobedel = True
'         End Select
'         textmsg = textmsg & Chr(13) & Chr(10) & sFormName & " . Nettoyage formulaire -> suppression du contrôle " & ctl.Name & " . tobedel " & tobedel
'        If tobedel Then        'Efface le controle
'                'Syntaxe DeleteControl frm.Name, ctl.Name
'                DeleteControl sFormName, ctl.Name      ' Delete control.
'        End If
'    Next ctl
'     If trcdbg Then MsgBox textmsg, vbOKOnly, wouca
'  ====================================================================================================
 
 
 
  'FERMETURE APRES NETTOYAGE
  'Syntaxe: DoCmd.Close acForm, "Order Review", acSaveYes
  Application.DoCmd.Close acForm, sFormName, acSaveYes   'Fermeture du formulaire receptacle en sauvegardant
 
Fin:
 
End Function
 
 
Private Sub Execute_Click()
'===================================
'Bonton Execute, recupère la requete SQL saisi par l'utilisateur et appelle les fonctions
'de nettoyage, puis alimentation du formulaire résultat
'===================================
 
    Const wouca = "FORMULAIRE Fdv_RQT_ALAVOLEE  _ [Bouton] Execute_Click"
    Dim execFonc As Boolean
    execFonc = False
 
' A terme : remplacer le forcage de trcdbg  par la lecture du mode debug en base, dansla tables des parametres
' car lorsque l'application sera bouclée, elles sera expoté pour être utlisée de façon autonome avec la runtime MsAccess
' Elle devra donc embarquer, l'export de sources ( pour mémoire ou pedagogie), le mode debug activable/desactivable pour
' mieux identifier un dysfonctionnement, et etre en capacité de le contourner, l'export de données au format CSV
' le requeteur integègré, un minimun de documentation (shéma de base, plan des formulaires de l'appli) 
' Pour la mise au point, tel un bouchon, on force la variable trcdbg 
  Dim trcdbg As Boolean
    trcdbg = True
 
    If trcdbg Then MsgBox "Demande d'execution de la requête : " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & CALCUL_GRSQL, vbOKOnly, wouca
 
    ' Appel de a fonction de nettoyage du formulaire receptacle
    execFonc = NETTOIE_FORM_RECPT("Fdv_RQT_ALAVOLEE_RESULT", trcdbg)
 
    If trcdbg Then MsgBox "Nettoyage avant execution effectué. Requête : " & Chr(13) & Chr(10) & Chr(13) & Chr(10) & CALCUL_GRSQL, vbOKOnly, wouca
 
    ' Appel de la fonction  peuplant le formulaire  Fdv_RQT_ALAVOLEE_RESULT
    ' en fonction du contenu de la requete
    execFonc = mfForm_AddControls("Fdv_RQT_ALAVOLEE_RESULT", CALCUL_GRSQL, trcdbg)
 
    GoTo Fin
 
Err_execFonc:  'etiquette  ' gestion de l'erreur
    Dim TxtError As String
    TxtError = "_ ERR _ Sub Execute_Click() " & "  !!! " & Err.Description & " !!!"
    TxtError = TxtError & Chr(13) & Chr(10) & Chr(13) & Chr(10) & CALCUL_GRSQL
    MsgBox TxtError, vbCritical, wouca
    Resume Exit_Execute_Click ' sortie de la procédure en erreur
Exit_Execute_Click:
    'effacer les champs crés dans le formulaire commencé dans cette fonction
Fin:
 
End Sub

Fermeture de formulaire : Comment empecher la question 'voulez vous enregistrer etc. [AC-2010]

IHM

Discussions similaires

Partager

Partager