réutilisation d'une base de donnée mais plantage

**cvivi60** · 25/09/2009, 11h31

bonjour !

JE vous écris car on vient de me demander de prendre une base de données existante et de la vider car nous n'en avons plus l'utilité, pour l'utiliser pour le même genre de base.

Mais j'ai 2 soucis :

1/ quand je vide la base de données des coordonnées, la base ne veut plus s'ouvrir.

2/ je garde 2 enregistrements pour qu'elle puisse fonctionner et je rajoute en test un enregistrement elle me met en n° auto 3460000 alors que je voudrais repartir depuis 1. Je sais qu'il faut vider la base et la compresser mais vu que quand je vide la base elle ne veut plus s'ouvrir.

Merci de votre aide d'avance.

virginie

Invité · 25/09/2009, 11h41

Bonjour

Lorsque tu vides cette base, as-tu un message d'erreur ?

Lorsque tu dis vider, qu'as-tu fait ?

As-tu touché aux tables système ? Si c'est le cas, il ne faut pas.

Philippe

**cvivi60** · 25/09/2009, 11h45

je n'ai aucunes erreures qui s'affiche juste elle démarre et se fige.

Et oui je vide les enregistrements en supprimant sur ma table coordonnée. Je ne dois pas faire ca ?

Je laisse la ligne de base tout de même : (numéro auto) ect ...

Dois je vider ma base directement sur acces ? mais là ca va me prendre du temps à moins qu'il y ai une autre soluce.

Invité · 25/09/2009, 11h48

Re

Envoyé par cvivi60

Et oui je vide les enregistrements en supprimant sur ma table coordonnée. Je ne dois pas faire ca ?

Si j'ai bien compris tu supprimes une table, si c'est le cas non, il faut les vider.

**cvivi60** · 25/09/2009, 12h17

non je ne supprime pas la table je l'ouvre et je supprime les enregistrements qui sont à l'interrieur

Invité · 25/09/2009, 12h25

Re

Tu le fais sur une seule table ou sur toutes ?

Si ce n'est que sur cette table, il se peut qu'il y ait des liaisons avec d'autres, et cela peut-être à l'origine du figeage.

Philippe

**cvivi60** · 25/09/2009, 13h38

je l'ai fait sur toutes les tables. Je les met toutes vides afin d'avoir une base de données vides à remplir.

Invité · 25/09/2009, 13h58

Autre possibilité, un code au démarrage qui teste quelque chose sur une table.

As-tu dans ta base une macro qui se nomme AutoExe, une macro, pas une code VBA ?

Philippe

**cvivi60** · 25/09/2009, 14h14

non pas de macro de ce nom.

En faite la base se fige pas mais ma fenetre de recherche n'affiche pas les champs elle fait une fenetre grise.

**Domi2** · 25/09/2009, 14h24

Bonjour,

En complément à la précédente demande de Philippe...

Lorsque tu utilises ta base, un formulaire s'affiche-t-il lors de l'ouverture ?

Si oui, est-ce qu'il exécute du code VBA dans les événements Sur chargement, Sur Ouverture ou Sur Activation ?

Dans l'affirmative, pourrais-tu poster le code ?

Domi2

Invité · 25/09/2009, 14h25

Je t'avoue que je ne vois pas ce qui se passe ?

Une dernière chose si les tables systèmes (celles qui commencent par Msys) sont affichées, est-ce que tu a vidé les données à l'intérieur ? Si oui, il ne faut pas le faire.

Sinon, je t'avoue que je ne sais pas

**cvivi60** · 25/09/2009, 14h30

oui toute a fait un formulaire de recherche s'affiche. Le code est long mais le voici :

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
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
 Private Sub cadreap_Click()
    If (cadreap.Value = "1") Then
        aptxt.Value = True
    End If
    If (cadreap.Value = "2") Then
        aptxt.Value = False
    End If
    If (cadreap.Value = "3") Then
        aptxt.Value = "*"
    End If
End Sub
 
Private Sub cadrearp_Click()
    If (cadrearp.Value = "1") Then
        arptxt.Value = True
    End If
    If (cadrearp.Value = "2") Then
        arptxt.Value = False
    End If
    If (cadrearp.Value = "3") Then
        arptxt.Value = "*"
    End If
End Sub
 
Private Sub Cadrebg_Click()
    If (Cadrebg.Value = "1") Then
        bgtxt.Value = True
    End If
    If (Cadrebg.Value = "2") Then
        bgtxt.Value = False
    End If
    If (Cadrebg.Value = "3") Then
        bgtxt.Value = "*"
    End If
 
End Sub
 
Private Sub combox_commande_Click()
    'Commande Combox
    If (combox_devis.Value = "1") Then
        fl_devis.Value = "*"
    End If
    If (combox_devis.Value = "2") Then
        fl_devis.Value = True
    End If
    If (combox_devis.Value = "3") Then
        fl_devis.Value = False
        combox_commande.Value = "3"
        fl_commande.Value = False
    End If
 
    If (combox_commande.Value = "1") Then
        fl_commande.Value = "*"
    End If
    If (combox_commande.Value = "2") Then
        fl_commande.Value = True
        fl_devis.Value = True
        combox_devis.Value = "2"
    End If
    If (combox_commande.Value = "3") Then
        fl_commande.Value = False
    End If
End Sub
 
Private Sub combox_devis_Click()
    'Devis Combox
    If (combox_devis.Value = "1") Then
        fl_devis.Value = "*"
    End If
    If (combox_devis.Value = "2") Then
        fl_devis.Value = True
    End If
    If (combox_devis.Value = "3") Then
        fl_devis.Value = False
        combox_commande.Value = "3"
        fl_commande.Value = False
    End If
 
    If (combox_commande.Value = "1") Then
        fl_commande.Value = "*"
    End If
    If (combox_commande.Value = "2") Then
        fl_commande.Value = True
        fl_devis.Value = True
        combox_devis.Value = "2"
    End If
    If (combox_commande.Value = "3") Then
        fl_commande.Value = False
    End If
End Sub
 
Private Sub Commande238_Click()
On Error GoTo Err_Commande238_Click
 
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
Exit_Commande238_Click:
    Exit Sub
 
Err_Commande238_Click:
    MsgBox Err.Description
    Resume Exit_Commande238_Click
 
End Sub
 
 
 
 
Private Sub Commande332_Click()
 
'Sélection tout effacer de la liste
 
Dim db As DAO.Database
Dim rst As DAO.Recordset
 
' Ouvrir le recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("coord")
 
While Not rst.EOF
 
rst.Edit
    rst("rqt") = False
rst.Update
 
'Passer à l'enregistrement suivant
rst.MoveNext
 
Wend
 
'On ferme
rst.Close
Set rst = Nothing
Set db = Nothing
 
DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
 
End Sub
 
Private Sub Commande333_Click()
' Effacer le contact sélectionner de la sélection
If (listeselection.Value <> 0) Then
 
    'Sélection tout effacer de la liste
 
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
 
    ' Ouvrir le recordset
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("SELECT * FROM [Coord] WHERE [N°]=" & listeselection.Value)
 
    'Passer en mode édition
    rst.Edit
        rst("rqt") = False
    rst.Update
 
    'On ferme
    rst.Close
    Set rst = Nothing
    Set db = Nothing
 
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
End If
 
 
End Sub
 
 
Private Sub Commande342_Click()
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "formIE"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
End Sub
 
Private Sub Form_Current()
    fl_entre.Value = "01/01/2008"
    fl_et.Value = Now + 1
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
End Sub
 
 
 
Private Sub Commande326_Click()
On Error GoTo Err_Commande326_Click
 
 
    'INITALISATION DE LA RECHERCHE
    fl_et.Value = Now + 1
    fl_entre.Value = "01/01/2008"
    fl_raisonsoc.Value = "*"
    fl_nom.Value = "*"
    fl_prenom.Value = "*"
    fl_adresse.Value = "*"
    fl_codepost.Value = "*"
    fl_commune.Value = "*"
    fl_adressebis.Value = "*"
    fl_communebis.Value = "*"
    fl_codepostbis.Value = "*"
    fl_devis.Value = "*"
    fl_commande.Value = "*"
    fl_observation.Value = "*"
    fl_mail.Value = "*"
    fl_type.Value = "*"
    fl_origine.Value = "*"
    fl_n.Value = "*"
    combox_devis.Value = "1"
    combox_commande.Value = "1"
    Autre.Value = "*"
    cadrearp.Value = "*"
    cadreap.Value = "*"
    Cadrebg.Value = "*"
    aptxt.Value = "*"
    arptxt.Value = "*"
    bgtxt.Value = "*"
 
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
Exit_Commande326_Click:
    Exit Sub
 
Err_Commande326_Click:
    MsgBox Err.Description
    Resume Exit_Commande326_Click
 
End Sub
Private Sub Commande331_Click()
On Error GoTo Err_Commande331_Click
 
 
    DoCmd.GoToRecord , , acLast
 
Exit_Commande331_Click:
    Exit Sub
 
Err_Commande331_Click:
    MsgBox Err.Description
    Resume Exit_Commande331_Click
 
End Sub
 
 
Private Sub Liste53_DblClick(Cancel As Integer)
On Error GoTo Err_Liste53_Click
 
    Dim stDocName As String
    stDocName = "ouverture client/prospect1"
 
 
    If Liste53.Value <> 0 Then
        If Liste53.Value <> "*" Then
            DoCmd.RunMacro stDocName
        End If
    End If
 
Exit_Liste53_Click:
    Exit Sub
 
Err_Liste53_Click:
    MsgBox Err.Description
    Resume Exit_Liste53_Click
End Sub
 
Private Sub Liste53_KeyDown(KeyCode As Integer, Shift As Integer)
' Ajouter à la sélection
If (Liste53.Value <> 0) Then
 
    'Sélection tout effacer de la liste
 
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
 
    ' Ouvrir le recordset
    Set db = CurrentDb()
    Set rst = db.OpenRecordset("SELECT * FROM [Coord] WHERE [N°]=" & Liste53.Value)
 
    'Passer en mode édition
    rst.Edit
        rst("rqt") = True
    rst.Update
 
    'On ferme
    rst.Close
    Set rst = Nothing
    Set db = Nothing
 
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
End If
End Sub
Private Sub Commande340_Click()
On Error GoTo Err_Commande340_Click
 
    Dim stDocName As String
 
    stDocName = "ETAT Rqt Selection"
    DoCmd.OutputTo acReport, stDocName
 
Exit_Commande340_Click:
    Exit Sub
 
Err_Commande340_Click:
    MsgBox Err.Description
    Resume Exit_Commande340_Click
 
End Sub
 
 
 
 
'Word application
Private Sub Commande351_Click()
 
Dim wdapp As Word.Application, doc As Word.Document
Dim db As DAO.Database, rst As DAO.Recordset
Dim dbG As DAO.Database, rstG As DAO.Recordset, numvar As Variant
Dim strsql As String, strNoveauFichier As String
 
'Vérifier si un interlocuteur est bien sélectionné
 
On Error GoTo Err_Commande351_Click
If Me.listeselection.ListCount = 0 Then
    MsgBox "Sélectionnez au moins un interlocuteur au préalable!", vbExclamation, "Publipostage"
    Exit Sub
End If
 
'Ouvrir le documents courrier.doc
'Set doc = wdapp.Documents.Open("c:\publipostage.doc")
Dim fd As FileDialog
Dim varfichier As Variant
Set fd = Application.FileDialog(msoFileDialogOpen)
fd.Title = "Choisissez un courrier"
fd.InitialFileName = "*.doc"
fd.AllowMultiSelect = True
 
'Ouvrir boîte de dialogue
If fd.Show = False Then
    'l'action est annulée
    Set fd = Nothing
    Exit Sub
End If
 
'ouverture rqt générale :
Set dbG = CurrentDb()
Set rstG = dbG.OpenRecordset("Rqt selection")
 
 
'Parcourir tous les enregistrements
While Not rstG.EOF
 
    'Récup Numéro pour séléection
    numvar = rstG("N°")
 
 
    'Ouverture requête
    Set db = CurrentDb()
    strsql = "SELECT * FROM [Rqt Selection] WHERE [N°]=" & numvar & ";"
    Set rst = db.OpenRecordset(strsql)
 
 
    'Ouvrir Word
    Set wdapp = CreateObject("Word.application")
    'wdapp.Visible = True
 
 
    'Dim varfichier As Variant
    For Each varfichier In fd.SelectedItems
        Set doc = wdapp.Documents.Open(varfichier)
    Next
 
 
    'Remplacerles signets par la bonne adresse
 
 
    Dim strnom As Variant, strprenom As Variant, stradresse As Variant
    Dim strnomprenom As Variant
 
 
    strnom = Nz(rst("nom"))
    strprenom = Nz(rst("prenom"))
    strnomprenom = strnom & " " & strprenom
    If (Nz(rst("raisonsoc")) = strnomprenom) Then
        strnomprenom = " "
    End If
 
 
    stradresse = Nz(rst("adresse"))
    If (stradresse = "Inc") Then
        stradresse = " "
    End If
 
    With doc
        .Bookmarks("SOCIETE").Range.Text = Nz(rst("raisonsoc"))
        .Bookmarks("NOMPRENOM").Range.Text = strnomprenom
        .Bookmarks("ADRESSE").Range.Text = stradresse
        .Bookmarks("CP").Range.Text = Nz(rst("codepost"))
        .Bookmarks("VILLE").Range.Text = Nz(rst("commune"))
    End With
 
 
    'Imprimer
    doc.PrintOut
 
    'Enregister défaut
    strNouveaudoc = "c:\dernier publipostage.doc"
    doc.SaveAs strNouveaudoc
 
 
    'fermer Word
 
    doc.Close
    wdapp.Quit
 
 
    'fermer requete
    rst.Close
 
    'Liberer objet sous rqt
    Set rst = Nothing
    Set db = Nothing
    Set doc = Nothing
    Set wdapp = Nothing
 
    'passer au suivant
    rstG.MoveNext
 
Wend
 
Exit_Commande351_Click:
    Set rstG = Nothing
    Set dbG = Nothing
    Set doc = Nothing
    Set wdapp = Nothing
    Set rst = Nothing
    Set db = Nothing
    Set doc = Nothing
Exit Sub
 
 
Err_Commande351_Click:
    MsgBox Err.Description
    Resume Exit_Commande351_Click
 
 
End Sub
 
 
Private Sub Commande352_Click()
On Error GoTo Err_Commande352_Click
 
 
    DoCmd.Close
 
Exit_Commande352_Click:
    Exit Sub
 
Err_Commande352_Click:
    MsgBox Err.Description
    Resume Exit_Commande352_Click
 
End Sub
Private Sub Commande353_Click()
On Error GoTo Err_Commande353_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "Nouveau Prospect/client"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_Commande353_Click:
    Exit Sub
 
Err_Commande353_Click:
    MsgBox Err.Description
    Resume Exit_Commande353_Click
 
End Sub
Private Sub Commande357_Click()
On Error GoTo Err_Commande357_Click
 
    Dim stDocName As String
 
    stDocName = "Rqt_ListeAutre"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
Exit_Commande357_Click:
    Exit Sub
 
Err_Commande357_Click:
    MsgBox Err.Description
    Resume Exit_Commande357_Click
 
End Sub
Private Sub Commande358_Click()
On Error GoTo Err_Commande358_Click
 
On Error GoTo Err_Commande358_Click
If Me.listeselectionbis.ListCount = 0 Then
    MsgBox "Sélectionnez au moins un interlocuteur au préalable!", vbExclamation, "Publipostage"
    Exit Sub
End If
 
Dim antvar As String
Dim aprvar As String
Dim milvar As String
Dim Nbvar As Long
Dim milvarbis As String
Dim db As DAO.Database
Dim rst As DAO.Recordset
 
antvar = ""
aprvar = ""
milvar = ""
Set db = CurrentDb()
Set rst = db.OpenRecordset("rqt selection bis")
 
While Not rst.EOF
    antvar = rst("E-mail")
    milvar = aprvar & ";" & antvar
    If Left(milvar, 1) = ";" Then
        milvar = antvar
    End If
    aprvar = milvar
    rst.MoveNext
Wend
 
DoCmd.SendObject acSendNoObject, , , , , aprvar
 
Exit_Commande358_Click:
    rst.Close
    Set rst = Nothing
    Set db = Nothing
    Exit Sub
 
Err_Commande358_Click:
    MsgBox Err.Description
    Resume Exit_Commande358_Click
 
End Sub
 
Private Sub listeselection_DblClick(Cancel As Integer)
On Error GoTo Err_listeselection_Click
 
    Dim stDocName As String
    stDocName = "ouverture client/prospect2"
 
 
    If listeselection.Value <> 0 Then
        DoCmd.RunMacro stDocName
    End If
 
Exit_listeselection_Click:
    Exit Sub
 
Err_listeselection_Click:
    MsgBox Err.Description
    Resume Exit_listeselection_Click
End Sub

**Domi2** · 25/09/2009, 14h45

Re,

A priori, pas de codes exécuté lors de l'ouverture du formulaire.

Si tu désactives l'ouverture du formulaire de recherche au démarrage, est-ce que ton appli "plante" également ? Plus de réaction sur la fenêtre de base de données ou autre ?

Et peut-être une autre vérification. Alt+F11 pour aller dans l'éditeur VBE, puis menu Débogage ==> Compiler (NomDeTonProjet).

Cela compile correctement ? Aucune erreur ?

Domi2

**cvivi60** · 25/09/2009, 14h58

la compile se fait correctement pas d'erreur.

Et comment désactiver le formulaire ?

Sinon ca plante pas ca me met une fenetre grise sans rien dessus mais j'ai acces a la modification de la base.

**cvivi60** · 25/09/2009, 15h07

en faite on dirait que le formulaire se désactive comme il y a pas d'enregistrements. Je peux comprendre car y a rien a chercher mais faudrait qu'on puisse pouvoir créer des fiches dans ce formulaire au moins. donc que le bouton "nouveau" puisse être utiliser.

**Domi2** · 25/09/2009, 15h08

Ok,

Alors, vérifie en mode création de ton formulaire si la propriété Source est renseignée.

Domi2

**cvivi60** · 25/09/2009, 15h16

bon c'est pas grave on a créer un enregistrement test et là ca fonctionne. Le compter n° auto est revenu au départ ! et le formulaire s'affiche car il y a un enregistrement.

Merci pour votre aide

virginie

**Domi2** · 25/09/2009, 15h20

Re,

Je n'ai pas vu le message précédent...

Pour faire les choses proprement :

Dans l'événement Sur Ouverture du formulaire, cliquer à droite sur les ..., choisir générer code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Private Sub Form_Load()
 
    'Vérifie s'il existe déjà des enregistrements dans la table
    If Me.RecordsetClone.RecordCount = 0 Then
 
        'Aucun enregistrement. On en ajoute directement un
        DoCmd.GoToRecord , , acNewRec
 
    End If
 
End Sub

Ensuite, ouvrir la base en maintenant la touche Shift enfoncée. Le formulaire ne se lance pas. Vider les tables, compacter la base pour réinitialiser les num auto, la relancer.

Le formulaire devrait se positionner sur un nouvel enregistrement.

Domi2