Discussion :

[mcryco]

Bonjour j'ai besoin d'aide pour mon code VBA
Le code ci-dessous marcher très bien avant que je fractionne ma base de donnée et je sais pas quoi faire

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
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
Option Compare Database
Dim db As DAO.Database
Dim Tb, tl, tf As Recordset
Dim nam, nam0, rech
Dim i, cont As Integer
Dim isql
Dim C As Control
Dim lot As String
Dim dur, dur2 As Variant
 
Private Sub No_GotFocus() 'No liste destinataire
 
    isql = "select [No]from destinataire where 1=1"
 
    No.RowSource = isql
 
End Sub
 
Private Sub No_LostFocus()
 
    Set db = CurrentDb()
    Set Tb = db.OpenRecordset("destinataire")
 
    Tb.Index = "No"
 
    If Me.No <> "" Then
 
    Tb.Seek "=", Me.No
 
    If Not Tb.NoMatch Then
 
        Tb.Edit
       For i = 0 To Me.Controls.Count - 1
            Set C = Me.Controls(i)
            If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
                On Error Resume Next
                Me(C.Name) = Tb(C.Name)
 
            End If
        Next
 
    End If
 
    End If
 
 
End Sub
 
Private Sub Enregistrer_Click()
 
Set db = CurrentDb()
Set Tb = db.OpenRecordset("destinataire")
 
Tb.Index = "No"
 
 
If Me.No <> "" And Me.destinataires <> "" Then
 
Tb.Seek "=", Me.No
 
If Tb.NoMatch Then
 
    Tb.AddNew
   For i = 0 To Me.Controls.Count - 1
        Set C = Me.Controls(i)
        If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
 
            On Error Resume Next
            Tb(C.Name) = Me(C.Name)
 
        End If
    Next
 Tb.Update
 
    MsgBox "NOUVEAU DESTINATAIRE", , "GESTOCK"
 
 
    '------------- fafana ny formulaire ------------------------------
 
       For i = 0 To Me.Controls.Count - 1
        Set C = Me.Controls(i)
        If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
            Me(C.Name) = ""
        End If
    Next
 
    Me.No.SetFocus
 
 
Else
 
    If MsgBox("DESTINATAIRE EXISTANT" & Chr(13) + Chr(10) & "Continuer modification?", vbCritical + vbYesNo, "GESTOCK") = vbYes Then
 
           '  verifier aloha ny Mot de passe
 
            Set tf = db.OpenRecordset("UTILISATEUR_EN_COURS")
            Set tl = db.OpenRecordset("UTILISATEURS")
 
            tf.MoveLast
            tf.Edit
 
            tl.Index = "N"
 
                tl.Seek "=", tf("N")
 
                    If Not tl.NoMatch Then
 
                       tl.Edit
 
                       If Me.LOGIN = tl("PASSWORD") Then
 
                       ' zay vao manao MAJ
 
                            Tb.Edit
 
                            For i = 0 To Me.Controls.Count - 1
                                 Set C = Me.Controls(i)
                                 If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
                                     On Error Resume Next
                                     Tb(C.Name) = Me(C.Name)
 
                                 End If
                             Next
                             Tb.Update
 
                             ' atao MAJ ny nom_article ao @ mouvement
 
                             db.Execute "UPDATE mouvement SET Demandeur='" & Me.destinataires & "' WHERE matricule='" & Me.No & "'"
 
 
                             MsgBox "INFO DESTINATAIRE MISE A JOUR!", , "GESTOCK"
 
                       Else
 
 
                             'tsy mahazo manova
 
                            MsgBox "OPERATION NON AUTORISEE", _
                            vbOKOnly + vbCritical, "GESTOCK"
 
 
                       End If
 
                 End If
 
    End If
 
End If
 
End If
End Sub
Private Sub ferm_fournisseur_Click()
On Error GoTo Err_ferm_fournisseur_Click
 
    DoCmd.Close
 
Exit_ferm_fournisseur_Click:
 
    Exit Sub
 
Err_ferm_fournisseur_Click:
    MsgBox Err.Description
    Resume Exit_ferm_fournisseur_Click
 
End Sub
 
Private Sub Form_Dirty(Cancel As Integer)
DoCmd.Close
End Sub
 
Private Sub Form_Open(Cancel As Integer)
 
On Error Resume Next
 
Set db = CurrentDb()
Set tl = db.OpenRecordset("destinataire")
tl.Index = "No"
 
tl.MoveLast
 
   For i = 0 To Me.Controls.Count - 1
        Set C = Me.Controls(i)
        If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
            On Error Resume Next
            Me(C.Name) = tl(C.Name)
 
        End If
    Next
 
 
x = tl("No")
y = tl("destinataires")
 
 
message.Caption = "DERNIERE ENREGISTREMENT : " & x & " " & y
 
 
Set tl = Nothing
 
End Sub
 
Private Sub PRECEDENT_Click()
 
Set db = CurrentDb()
Set Tb = db.OpenRecordset("destinataire")
 
Tb.Index = "No"
 
 
If Me.No <> "" And Me.destinataires <> "" Then
 
Tb.Seek "=", Me.No
 
If Not Tb.BOF Then
 
   Tb.MovePrevious
 
   For i = 0 To Me.Controls.Count - 1
        Set C = Me.Controls(i)
        If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
            On Error Resume Next
            Me(C.Name) = Tb(C.Name)
 
        End If
    Next
 
End If
 
End If
 
End Sub
 
 
Private Sub SUIVANT_Click()
 
Set db = CurrentDb()
Set Tb = db.OpenRecordset("destinataire")
 
Tb.Index = "No"
 
If Me.No <> "" And Me.destinataires <> "" Then
 
Tb.Seek "=", Me.No
 
   Tb.MoveNext
 
   For i = 0 To Me.Controls.Count - 1
        Set C = Me.Controls(i)
        If (C.ControlType = acTextBox Or C.ControlType = acComboBox) Then
            On Error Resume Next
            Me(C.Name) = Tb(C.Name)
 
        End If
    Next
 
 
End If
 
 
End Sub
 
Private Sub SUPPRIMER_Click()
 
 
If Me.No <> "" Then
 
Set db = CurrentDb()
Set Tb = db.OpenRecordset("UTILISATEUR_EN_COURS")
Set tl = db.OpenRecordset("UTILISATEURS")
 
Tb.MoveLast
Tb.Edit
 
tl.Index = "N"
 
    tl.Seek "=", Tb("N")
 
        If Not tl.NoMatch Then
 
           tl.Edit
 
           If Me.LOGIN = tl("PASSWORD") Then
 
                If MsgBox("SUPPRIMER DESTINATAIRE?", _
                vbInformation + vbYesNo, "GESTOCK") = vbYes Then
 
                    db.Execute "DELETE * FROM destinataire WHERE [No]=" & Me.No & ""
 
                    MsgBox "SUPPRESSION TERMINEE!", vbOKOnly, _
                    "GESTOCK"
 
                End If
 
            Else
 
                MsgBox "OPERATION NON AUTORISEE", _
                vbOKOnly + vbCritical, "GESTOCK"
 
            End If
 
    End If
 
End If
 
End Sub

[nico84]

Bonjour,

Qu'est ce qui ne marche plus ?
Après avoir fractionné il faut lier les tables de la dorsale à la frontale pour que ça marche "comme avant"

Par ailleurs je pense qu'il est nécessaire de fermer db et tb autant de fois qu'il est ouvert pour libérer la mémoire réservée...

[Tofalu]

La méthode seek s'applique aux recordset ouverts en mode dbOpenTable (par défaut quand la table n'est pas fractionnée).

Lorsque la base de données est fractionnée, les recordsets sont ouverts en mode dbOpenDynaset (dbOpenTable n'est pas disponible dans ce contexte). La méthode Seek n'est alors plus utilisable. Elle doit être remplacée par FindFirst.