Codes qui ne fonctionne plus

**FCL31** · 05/11/2007, 12h52

J'ai un gros probléme :

Sur un formulaire avec des codes, certaines fonctions qui sont liées a des codes ne marche plus. Pourquoi ?
Quelqu'un peut il m'aider SVP

Sur d'autres formulaires les codes marchent (a premiére vu)

(a savoir que j'ai remarqué que dans le formulaire les ordres de tabulation ont changé)

Merci

Invité · 05/11/2007, 13h37

Bonjour

Peut-être qu'avec le code on verrait plus clair, non !

Starec

**FCL31** · 06/11/2007, 09h23

Ce qui est en vert sa marche mais le reste ? Certain c’est sur sa marche pas mais peut être que d’autre sa marche mais je n’ai pas tout vérifié.
La premiere partie marche (code sur la fonction de la souris).

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
Option Compare Database
Option Explicit
--------------------------------------
Private WithEvents clMouseWHeel As MouseWheelDVP.cMouseWheel
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetFocus Lib "user32" () As Long
Private Const WM_VSCROLL = &H115
Private Const SB_LINEUP = 0
Private Const SB_LINEDOWN = 1
------------------------------------
Private Sub clMouseWHeel_MouseWheel(Cancel As Integer, FormScroll As Integer, Delta As Long)
Cancel = True
Dim lhWnd As Long
On Error Resume Next
If Screen.ActiveControl.Name <> "Bloc" Then Exit Sub
If Err.Number <> 0 Then Exit Sub
On Error GoTo 0
lhWnd = GetFocus
If Delta < 0 Then
SendMessage lhWnd, WM_VSCROLL, SB_LINEDOWN, 0&
Else
SendMessage lhWnd, WM_VSCROLL, SB_LINEUP, 0&
End If
End Sub
------------------------------------------
Private Sub Commande108_DblClick(Cancel As Integer)
Me.AllowAdditions = True
ActiveTextBox True
On Error GoTo Err_Commande108_Click
    DoCmd.GoToRecord , , acNewRec
Exit_Commande108_Click:
    Exit Sub
Err_Commande108_Click:
    MsgBox Err.Description
    Resume Exit_Commande108_Click
ActiveTextBox True
End Sub
-------------------------------------------
Private Sub Form_Close()
    If Not (clMouseWHeel Is Nothing) Then
        Set clMouseWHeel = Nothing
    End If
End Sub
--------------------------------------
Private Sub Form_Load()
    Set clMouseWHeel = New MouseWheelDVP.cMouseWheel
    Set clMouseWHeel.Form = Me
End Sub
---------------------------------------------------
Sub ActiveTextBox(etat As Boolean)
    Dim oCtrl As Control
    For Each oCtrl In Me.Controls
        If TypeOf oCtrl Is TextBox Then
            oCtrl.Enabled = etat
        End If
    Next oCtrl
End Sub
-------------------------------------------------------
Private Sub C_Click()
If Me.C.Value = True Then
   Me.EC.Value = False
   Me.RT.Value = False
 End If
End Sub
----------------------------------------------------------
Private Sub Case_Refus_Click()
If Me.Case_Refus.Value = True Then
   Me.Ok_prise_en_Charge.Value = False
End If
End Sub
------------------------------------------
Private Sub Commande18_Click()
On Error GoTo Err_Commande18_Click
    DoCmd.Close
Exit_Commande18_Click:
Exit Sub
Err_Commande18_Click:
    MsgBox Err.Description
    Resume Exit_Commande18_Click
End Sub
---------------------------------------
Private Sub New_enregis_Click()
On Error GoTo Err_New_enregis_Click
    Dim stDocName As String
    stDocName = "Valider"
    DoCmd.RunMacro stDocName
Exit_New_enregis_Click:
Exit Sub
Err_New_enregis_Click:
    MsgBox Err.Description
    Resume Exit_New_enregis_Click
End Sub
----------------------------------------
Private Sub Commande34_Click()
On Error GoTo Err_Commande34_Click
    Dim stDocName As String
    stDocName = "New sinistre"
    DoCmd.RunMacro stDocName
Exit_Commande34_Click:
Exit Sub
Err_Commande34_Click:
    MsgBox Err.Description
    Resume Exit_Commande34_Click
End Sub
---------------------------------------
Private Sub Commande103_Click()
DoCmd.RunCommand acCmdSaveRecord
ActiveTextBox False
End Sub
Private Sub Commande106_Click()
ActiveTextBox True
End Sub
-------------------------------------------
Private Sub Commande112_Click()
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenReport "Rq_Secure1", acViewNormal, , "Réf_Sinistre = '" & Me.Réf_Sinistre & "'"
End Sub
-------------------------------------------
Private Sub Conces_AfterUpdate()
Me.Conces = UCase(Me.Conces)
End Sub
------------------------------------------
Private Sub Date_de_la_panne_AfterUpdate()
Dim DateStart       As Date
Dim DateEnd         As Date
DateStart = DLookup("[Date_début_d'effet]", "Presses", "[N°Contrat] = '" & Me.n°Police & "'")
DateEnd = DLookup("[Date_fin_de_garantie]", "Presses", "[N°Contrat] = '" & Me.n°Police & "'")
    If Me.Date_de_la_panne < DateStart Then
        MsgBox "Contrat pas commencé", vbExclamation, "Validité du contrat"
        Exit Sub
    ElseIf Me.Date_de_la_panne > DateEnd Then
        MsgBox "Contrat terminé", vbExclamation, "Validité du contrat"
        Exit Sub
    Else
        MsgBox "Contrat en cours", vbInformation, "Validité du contrat"
    End If
End Sub
------------------------------------------------
Private Sub EC_Click()
If Me.EC.Value = True Then
   Me.C.Value = False
   Me.RT.Value = False
End If
End Sub
---------------------------------------------
Private Sub Form_Open(Cancel As Integer)
ActiveTextBox False
End Sub
--------------------------------------------
Private Sub nbr_de_balles_AfterUpdate()
If Me.Type_de_presse_2.Column(2) = "BR" And Me.nbr_de_balles > 12000 Then
   MsgBox "Usage Dépassé maximum 12 000 pour les presses à balles rondes"
Else
If Me.Type_de_presse_2.Column(2) = "BC" And Me.nbr_de_balles > 30000 Then
   MsgBox "Usage Dépassé maximum 30 000 pour les presses à balles rectangulaires"
End If
End If
End Sub
---------------------------------------------------
Private Sub Ok_prise_en_Charge_Click()
If Me.Ok_prise_en_Charge.Value = True Then
   Me.Case_Refus.Value = False
End If
End Sub
------------------------------------------
Private Sub Recherche_Click()
On Error GoTo Err_Recherche_Click
    Screen.PreviousControl.SetFocus
    DoCmd.DoMenuItem acFormBar, acEditMenu, 10, , acMenuVer70
Exit_Recherche_Click:
Exit Sub
Err_Recherche_Click:
    MsgBox Err.Description
    Resume Exit_Recherche_Click
End Sub
------------------------------------------
Private Sub Commande36_Click()
On Error GoTo Err_Commande36_Click
    Dim stDocName As String
    stDocName = "Voir sinistres"
    DoCmd.RunMacro stDocName
Exit_Commande36_Click:
Exit Sub
Err_Commande36_Click:
    MsgBox Err.Description
    Resume Exit_Commande36_Click
End Sub
------------------------------------
Private Sub Commande37_Click()
On Error GoTo Err_Commande37_Click
    Dim stDocName As String
    stDocName = "Modif sinistres"
    DoCmd.RunMacro stDocName
Exit_Commande37_Click:
Exit Sub
Err_Commande37_Click:
    MsgBox Err.Description
    Resume Exit_Commande37_Click
End Sub
-------------------------------------
Private Sub Réf_piéce_AfterUpdate()
Me.Réf_piéce = UCase(Me.Réf_piéce)
End Sub
------------------------------------
Private Sub RT_Click()
If Me.RT.Value = True Then
   Me.EC.Value = False
   Me.C.Value = False
   End If
End Sub
---------------------------------------
Private Sub Commande90_Click()
On Error GoTo Err_Commande90_Click
    DoCmd.GoToRecord , , acPrevious
Exit_Commande90_Click:
    Exit Sub
Err_Commande90_Click:
    MsgBox Err.Description
    Resume Exit_Commande90_Click
End Sub
-------------------------------------
Private Sub Commande91_Click()
On Error GoTo Err_Commande91_Click
    DoCmd.GoToRecord , , acNext
Exit_Commande91_Click:
    Exit Sub
Err_Commande91_Click:
    MsgBox Err.Description
    Resume Exit_Commande91_Click
End Sub
---------------------------------------
Private Sub Commande110_Click()
On Error GoTo Err_Commande110_Click
    Dim stDocName As String
    stDocName = "Ouvrir Dsciptif"
    DoCmd.RunMacro stDocName
Exit_Commande110_Click:
    Exit Sub
Err_Commande110_Click:
    MsgBox Err.Description
    Resume Exit_Commande110_Click
End Sub

Si quelqu'un peu m'aider SVP

**Jean-Philippe André** · 06/11/2007, 09h33

salut,
alors on va le faire autrement, file nous le bout de code qui ne marche pas stp

,
tu crois quand même pas qu'on va te dire comme ca si ca marche ou pas...

**FCL31** · 06/11/2007, 09h44

Oui pardon tu as reson
Les codes suivant ne marche pas c'est sur. Mais il y en a peut être d'autre

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub C_Click()
If Me.C.Value = True Then
   Me.EC.Value = False
   Me.RT.Value = False
 End If
End Sub
----------------------------------------------------------
Private Sub Case_Refus_Click()
If Me.Case_Refus.Value = True Then
   Me.Ok_prise_en_Charge.Value = False
End If
End Sub

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
Private Sub Date_de_la_panne_AfterUpdate()
Dim DateStart       As Date
Dim DateEnd         As Date
DateStart = DLookup("[Date_début_d'effet]", "Presses", "[N°Contrat] = '" & Me.n°Police & "'")
DateEnd = DLookup("[Date_fin_de_garantie]", "Presses", "[N°Contrat] = '" & Me.n°Police & "'")
    If Me.Date_de_la_panne < DateStart Then
        MsgBox "Contrat pas commencé", vbExclamation, "Validité du contrat"
        Exit Sub
    ElseIf Me.Date_de_la_panne > DateEnd Then
        MsgBox "Contrat terminé", vbExclamation, "Validité du contrat"
        Exit Sub
    Else
        MsgBox "Contrat en cours", vbInformation, "Validité du contrat"
    End If
End Sub
------------------------------------------------
Private Sub EC_Click()
If Me.EC.Value = True Then
   Me.C.Value = False
   Me.RT.Value = False
End If
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub nbr_de_balles_AfterUpdate()
If Me.Type_de_presse_2.Column(2) = "BR" And Me.nbr_de_balles > 12000 Then
   MsgBox "Usage Dépassé maximum 12 000 pour les presses à balles rondes"
Else
If Me.Type_de_presse_2.Column(2) = "BC" And Me.nbr_de_balles > 30000 Then
   MsgBox "Usage Dépassé maximum 30 000 pour les presses à balles rectangulaires"
End If
End If
End Sub

Code :

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

1
2
3
4
5
6
Private Sub RT_Click()
If Me.RT.Value = True Then
   Me.EC.Value = False
   Me.C.Value = False
   End If
End Sub

Merci

**Jean-Philippe André** · 06/11/2007, 10h21

les évènements _click, je les changerai en _change perso.
pour les autres, tu as des messages d'erreur ? ou bien les requêtes ne retournent rien ? Regarde si les tables dans lesquelles tu effectues tes requêtes portent bien le même nom.

**FCL31** · 06/11/2007, 10h34

Tout marche bien sinon (a priori) sauf que les événements sur les case a cocher ou les zone de texte ne marche pas
Pas de message d'erreur, les requêtes marche bien
Les autres formulaires marche bien (a priori)

A savoir que les codes que j'ai fournis sont ceux d'un sous formulaire et les autres sous formulaires marchent bien.

Par contre je ne comprend pas :

les évènements _click, je les changerai en _change perso

**Jean-Philippe André** · 06/11/2007, 10h41

et bien au lieu de faire tourner le code à l'évènement click sur les checkboxes, tu les fais tourner sur les évènements change (passe de true->false et vice versa)

**FCL31** · 06/11/2007, 10h53

Escuse moi mais n'aitant pas tres fort avec les codes je ne comprend pas trop se que tu veu dire

N'y a t'il pas un simple probléme au niveau des référence dans visual basic (outils / référence)

**Jean-Philippe André** · 06/11/2007, 10h59

mdr, il me semble que c'est toi qui a le code sous les yeux, donc je te file ceci, et le reste tu le fais de façon autonome hein

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub C_Change()
If Me.C.Value = True Then
   Me.EC.Value = False
   Me.RT.Value = False
 End If
End Sub
----------------------------------------------------------
Private Sub Case_Refus_Change()
If Me.Case_Refus.Value = True Then
   Me.Ok_prise_en_Charge.Value = False
End If
End Sub

**FCL31** · 06/11/2007, 11h23

Pour les case a cocher je pense pas de probléme mais pour les zones de texte (saisi de chiffre et de date) je ne peu pas appliqué cette fonction : en effet la fonction va étre appliquée a chaque chiffre que je vai taper

Comment faire ??

Invité · 06/11/2007, 11h33

Bonjour

Je penses que jpcheck t'a déjà bien aidé.

Les contrôles réagissent différement en fonction des évènements.
Pour les zones de texte, il faut que tu crées une routine propres à ceux-ci sur l'AfterUpdate.

Tu auras du mal à avoir un code générique pour tout les contrôles. Tu as tous les élements pour réaliser ce que tu veux, grâce à l'aide de jpcheck.

Starec

**FCL31** · 06/11/2007, 12h13

Merci

Pour les zones de texte, il faut que tu crées une routine propres à ceux-ci sur l'AfterUpdate.

Pour les zones de texte c'est déjà le cas mais sa marche plus

Tous les codes marchaient mais Lundi lorsque j'ai voulu me servir de mon application sa ne marchait plus

Pourquoi ?

**FCL31** · 06/11/2007, 13h16

Désolé mais j'ai un autre code qui ne marche pas

Code :

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

1
2
3
Private Sub Réf_piéce_AfterUpdate()
Me.Réf_piéce = UCase(Me.Réf_piéce)
End Sub

Par contre j'ai testé la méthode de jpcheck (que je remerci pas avance) mais sa marche pas; du cout j'ai remis le code je j'avais precedaement et sa marche

Je comprend rien

SVP

**FCL31** · 06/11/2007, 15h17

J'ai réussi a tout refaire marcher : en refaisant les codes qui ne marchaient pas mais je pense que se n'est pas une solution et qu'il y a quand même un vrai problème quelque par mais où ?

Je n'affiche pas la discussion

car pour moi, même si sa marche je pense qu’il a un problème quelque par qui risque de revenir
Si quelqu'un a une explication qui pourrait dire le pourquoi du comment du problème ce serait cool.

**FCL31** · 06/11/2007, 15h53

Ok pas de probléme
C'est sur que je reviendrais si j'ai a nouveau le même probléme

Merci pour tout

**Pierre Fauconnier** · 08/11/2007, 15h00

Envoyé par jpcheck

et bien au lieu de faire tourner le code à l'évènement click sur les checkboxes, tu les fais tourner sur les évènements change (passe de true->false et vice versa)

A ma connaissance, il n'y a pas d'évènements Change sur les cases à cocher...

Peux-tu vérifier tes réponses avant de poster stp?

**Jean-Philippe André** · 08/11/2007, 15h05

si si

Code :

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

1
2
3
4
5
6
7
Private Sub CheckBox1_Change()
 
End Sub
 
Private Sub CheckBox1_Click()
 
End Sub

edit : ca marche sous excel, l'équivalent selon moi sous Access étant

Code :

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

1
2
3
Private Sub Cocher0_AfterUpdate()
 
End Sub

**Pierre Fauconnier** · 08/11/2007, 15h25

Envoyé par jpcheck

si si

Code :

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

1
2
3
4
5
6
7
Private Sub CheckBox1_Change()
 
End Sub
 
Private Sub CheckBox1_Click()
 
End Sub

edit : ca marche sous excel, l'équivalent selon moi sous Access étant

Code :

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

1
2
3
Private Sub Cocher0_AfterUpdate()
 
End Sub

Les checkbox d'Excel (useform) ne sont pas à confondre avec les checkbox des formulaires d'Access...

Dans ton message, tu donnais l'exemple changer les _click en _change et pas en _afterupdate.

A nouveau, vérifie tes réponses, car les gens qui posent des questions ne sont pas forcément à l'aise avec le code. Si tu leur dis _change, ils ne vont pas chercher _afterupdate et vont perdre du temps...

Sur les forums de DVP, la qualité est plus importante que la quantité...

Codes qui ne fonctionne plus

VBA Access

Discussions similaires

Partager

Partager