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.

Codes qui ne fonctionne plus

VBA Access

Vue hybride

Discussions similaires

Partager

Partager