[AC-2007] Vérifier l'existence de la clé primaire [Résolu]

[Flup]

Bonjour à tous,

Voilà le problème :

Une base de données gère les membres d'un club sportif. Chaque membre a un numéro, j'ai pris le "numauto" de la clé primaire pour cela.

Dans mon formulaire de saisies, j'ai prévu une zone texte (ScanCarte) dans laquelle on scane la carte du membre et la base de données nous dit si le membre est en ordre de cotisation ou non.

Comme tout est très fluctuant, j'ai entrepris, hier, de mettre de l'ordre dans tout ça et de supprimer les personnes n'étant plus en ordre de cotisation depuis un moment. La base de données a bien supprimé les membre "en trop" ainsi que leur numéro, tout s'est bien passé.

Comme je ne suis pas seul à me servir de cette base de données, il met venu l'idée de taper un numéro supprimé dans la zone "ScanCarte" et la machine me dit que le membre est en ordre de cotisation. Elle se base sur l'enregistrement actif. Pour moi, pas de problème, je le sais mais les personnes qui vont se servir de cette base de données risquent de ne plus rien comprendre.

La question est donc la suivante : Comment faire pour afficher un MsgBox précisant que ce numéro n'existe plus si l'on tape le numéro d'un membre supprimé de la base de données.

Je sais, il faudrait vraiment le vouloir pour se trouver dans cette configuration mais mes collègues sont capables de tout

Le code de la gestion de ce ScanCarte :

Code :

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
Private Sub ScanCarte_AfterUpdate()
On Error Resume Next
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "TMembre.[NumInscription] = " & Str(Nz(Me![ScanCarte], 0))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
 
    If Me![DateRenouvellement] > Date Then
      'petite boule verte affichée dans le formulaire
      Ivert.Visible = True
      Evert.Visible = True
      Irouge.Visible = False
      Erouge.Visible = False
      msg = "Le membre est en ordre de cotisation. Participe-t-il au cours ?"
      Style = vbYesNo + vbQuestion + vbDefaultButton1
      title = "Carte valide"
      response = MsgBox(msg, Style, title)
        If response = vbYes Then
          'Me!Participation = -1
          Me!DerniereVisite = Date
          Me.Requery
        End If
    Else
      'petite boule rouge affichée dans le formulaire (j'aurais bien mis un klaxon mais bon...)
      Irouge.Visible = True
      Erouge.Visible = True
      Ivert.Visible = False
      Evert.Visible = False
      msg = "La carte du membre n'est plus valide."
      Style = vbOK + vbCritical
      title = "Carte non valide"
      msg = MsgBox(msg, Style, title)
    End If
    ScanCarte = ""
    ScanCarte.SetFocus
    Ivert.Visible = False
    Evert.Visible = False
    Irouge.Visible = False
    Erouge.Visible = False
End Sub

Désolé d'avoir été un peu long et merci d'avance pour le petit coup de main éventuel.

Très bonne journée à tous

[bernardmichel]

Bonjour,

Pour solutionner ton problème, je procéderais de la sorte:

Lors d'une demande d'affichage d'un membre, je demanderais à Access de compter le nombre d'enregistrement est retourné avec le N° d'identifiant.
S'il est égal à zéro => Un msgbox apparaît
Sinon il affiche les données demandées.

[Orion34080]

Ci dessous un petit bout de code qui peut peut-être t'aider...

Code :

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
Private Sub ScanCarte_AfterUpdate()
On Error Resume Next
Dim rs As Recordset
Dim Non_Valide As Boolean
 
    Set rs = New ADODB.Recordset
    rs.Open "Select * from TMembre Where NumInscription = " & Str(Nz(Me.scancarte, 0)), CurrentProject.Connection, adOpenKeyset, adLockOptimistic
 
    Non_Valide = False
    If Not rs.EOF Then
        If Me![Daterenouvellement] > Date Then
            msg = "Le membre est en ordre de cotisation. Participe-t-il au cours ?"
            Style = vbYesNo + vbQuestion + vbDefaultButton1
            title = "Carte valide"
            response = MsgBox(msg, Style, title)
        Else
             Non_Valide = True
        End If
    Else
        Non_Valide = True
    End If
    If Non_Valide Then
        msg = "La carte du membre n'est plus valide."
        msg = MsgBox(msg)
    End If
End Sub

A vérifier cependant, je n'ai pas Access sous la main...

Michel

[Flup]

Bonjour BernardMichel,

Je comprends ton raisonnement mais pas la moindre idée de comment le mettre en oeuvre.
Merci pour ton aide

Bonjour Michel,

J'ai procédé, acces me retourne l'erreur de compilation suivante :

Code :

Set rs=NewADODB.recordset

et en surbrillance et le message est le suivant :

Erreur de compilation
Type défini par l'utilisateur non défini (ha ben oui, c'est pas moi qui le dit ).

J'adore ces messages d'une limpidité de bouillon de séminaire

Merci à toi de te pencher son mon "cas"

[Orion34080]

A mon avis cela peut venir de 2 choses :

tu écris :

Set rs=NewADODB.recordset

il faut écrire :

Code :

Set rs= New ADODB.recordset

ou, si cela ne vient pas de là, il te manque peut-être une référence :
"Microsoft ActiveX Data Objects 2.x Library"

pour vérifier ce point, tu ouvres un module quelconque et tu vas dans le menu OUTILS/REFERENCE et tu vérifies que cette référence est bien cochée. Si ce n'est pas le cas, tu la coches.

ENFIN
Si cela vient ni de l'espace oublié, ni de la référence manquante... et ben ! Je sais pas !!!

MAIS
Si cela devait fonctionner, fais tout de même attention dans "mon" code, après la ligne :

Code :

response = MsgBox(msg, Style, title)

, il te faut dire ce que cela doit faire en cas de réponse "oui" ou "non"

Michel

[Flup]

Re Michel,


J'avais bien un problème de référence, j'ai suivi ton conseil et maintenant le déboggeur bloque au niveau de la seconde ligne de code.

Pour l'autre souci, c'est moi qui ai oublié l'espace en recopiant cette ligne de code ici. Dans la base de données, c'est ok.

Je ne vais pas te déranger plus longtemps, je vais chercher encore un peu et si ça ne donne rien, tant pis

Mille mercis pour ton aide et très bonne soirée

[bernardmichel]

Pour préciser, voici un exemple (il te faut bien entendu contrôler la requête "sql") pour que cela ai l'effet escompté:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Dim rst     As DAO.Recordset
Dim sql     As String
 
' Composition d'une requête sql sélectionnant un enregistrement sur
' la base de "Me.ScanCarte*
    sql = "SELECT * FROM TMembre WHERE NumInscription " & Me.ScanCarte
 
    Set rst = CurrentDb.OpenRecordset(sql)
 
rst.MoveLast    ' On se rend au dernier enregistrement afin de tous les
                ' parcourir et ainsi rendre valable la fonction "RecordCount"
If rst.RecordCount > 0 Then ' Si l'enregistrement n'existe pas
 
' ... puis maintenant le reste de ton code en fonction du test ci-dessus.

Voilà, à priori, cela devrait fonctionner tout de suite, sans ajout de référence.

[Flup]

Bonjour BernardMichel,


C'est vraiment très gentil de t'accrocher de telle manière, pour ma part j'avais presque baisser les bras

Donc, j'ai suivi ton conseil et introduit le code suivant :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim rst     As DAO.Recordset
Dim sql     As String
 
' Composition d'une requête sql sélectionnant un enregistrement sur ' la base de "Me.ScanCarte*
   sql = "SELECT * FROM TMembre WHERE TMembre.NumInscription " & Me.ScanCarte
 
    Set rst = CurrentDb.OpenRecordset(sql)
 
rst.MoveLast    ' On se rend au dernier enregistrement afin de tous les
                ' parcourir et ainsi rendre valable la fonction "RecordCount"
If rst.RecordCount > 0 Then ' Si l'enregistrement n'existe pas
 
msg = "Ce membre n'est plus repris dans la base de données."
      Style = vbOK + vbCritical
      title = "Numéro de membre supprimé"
      msg = MsgBox(msg, Style, title)
End If

Je tape le chiffre 1 dans mon ScanCarte (membre supprimé) et ce bougre d'animal d'ordinateur me dit alors :

Erreur d'exécution
Erreur de syntaxe (opérateur absent) dans l'expression <<TMembre.NumInscription 1>>

Il met la ligne 2 en surbrillance dans le débogeur

Je ne suis décidemment pas copain avec les requêtes SQL

Bonne journée et pardon d'être aussi lent à la détente

[bernardmichel]

Deux petits bugs dans ma réponse:
La première, il faut évidemment insérer le signe "=" dans la requête, de cette façon:

Code :

sql = "SELECT * FROM TMembre WHERE NumInscription = " & Me.ScanCarte

Puis il faut ajouter en début de code:

Code :

On Error Resume Next ' Evite l'erreur sur "rst.MoveLast"

Voici mon petit bout de code (avec bien sûr une table et des champs autres que les tiens) pour vérifier et cela fonctionne:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Dim sql As String
Dim rst As DAO.Recordset
On Error Resume Next ' Evite l'erreur sur "rst.MoveLast"
 
    sql = "SELECT *FROM tblUser WHERE IdUsager= " & Me.Test
    Set rst = CurrentDb.OpenRecordset(sql)
    rst.MoveLast
    If rst.RecordCount = 1 Then
        MsgBox "Il existe"
    Else
        MsgBox "Inconnu"
    End If

[Arkham46]

bjr,

commencez par supprimer le on error resume next, on y verra plus clair
sinon chaque ligne est exécutée sans tenir compte des erreurs et le code fait n'importe quoi

s'il y a une erreur, il faut ajouter un test éventuellement en amont

[Flup]

Mille mercis BernardMichel, j'y suis

Le = j'avais trouvé mais je bloquais sur l'erreur "rst.movelast", l'affaire est dans le sac

Il me reste encore à trouver le moyen de redonner le focus à ma zone de saisie ScanCarte après chaque manipulation du formulaire (msgbox notamment).

Je me suis trouvé avec un nom de membre "236", ça manque de charme

Voilà le code complet pour info si besoin (maintenant que je sais comment mettre du code dans le forum ) :

Code :

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
Private Sub ScanCarte_AfterUpdate()
On Error Resume Next
Dim rst     As DAO.Recordset
Dim sql     As String
Dim rs As Object
 
' Composition d'une requête sql sélectionnant un enregistrement sur ' la base de "Me.ScanCarte*
   sql = "SELECT * FROM TMembre WHERE NumInscription= " & Me.ScanCarte
   Debug.Print sql
 
    Set rst = CurrentDb.OpenRecordset(sql)
 
rst.MoveLast    ' On se rend au dernier enregistrement afin de tous les
                ' parcourir et ainsi rendre valable la fonction "RecordCount"
If rst.RecordCount = 0 Then ' Si l'enregistrement n'existe pas
 
msg = "Ce membre n'est plus repris dans la base de données."
      Style = vbOK + vbCritical
      title = "Numéro de membre supprimé"
      msg = MsgBox(msg, Style, title)
      Exit Sub
End If
 
Set rs = Me.Recordset.Clone
rs.FindFirst "TMembre.[NumInscription] = " & Str(Nz(Me![ScanCarte], 0))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark
 
    If Me![DateRenouvellement] > Date Then
      'petite boule verte affichée dans le formulaire
      Ivert.Visible = True
      Evert.Visible = True
      Irouge.Visible = False
      Erouge.Visible = False
      msg = "Le membre est en ordre de cotisation. Participe-t-il au cours ?"
      Style = vbYesNo + vbQuestion + vbDefaultButton1
      title = "Carte valide"
      response = MsgBox(msg, Style, title)
        If response = vbYes Then
          'Me!Participation = -1
          Me!DerniereVisite = Date
          Me.Requery
        End If
    Else
      'petite boule rouge affichée dans le formulaire (j'aurais bien mis un klaxon mais bon...)
      Irouge.Visible = True
      Erouge.Visible = True
      Ivert.Visible = False
      Evert.Visible = False
      msg = "La carte du membre n'est plus valide."
      Style = vbOK + vbCritical
      title = "Carte non valide"
      msg = MsgBox(msg, Style, title)
    End If
    ScanCarte = ""
    ScanCarte.SetFocus
    Ivert.Visible = False
    Evert.Visible = False
    Irouge.Visible = False
    Erouge.Visible = False
End Sub

[bernardmichel]

Bjr,

En réponse à Arkham: Le "test en amont" dont tu fais mention est... justement le but du bout de code développé. Peut-être alors serait-il bon d'insérer, après le "rst.MoveLast" un "On Error Goto 0" pour supprimer l'effet de "On Error Resume Next". Mais, en l'espèce, tant que ce code n'évolue pas, il ne me semble pas problématique de le laisser tel quel

En réponse à FLUP: A placer en fin de code:

Code :

Me.ScanCarte.SetFocus

[Flup]

Envoyé par Arkham46

bjr,

commencez par supprimer le on error resume next, on y verra plus clair
sinon chaque ligne est exécutée sans tenir compte des erreurs et le code fait n'importe quoi

s'il y a une erreur, il faut ajouter un test éventuellement en amont

Bonjour Arkham46

Ben là ça fonctionne, je n'ose même plus respirer, je regarde l'écran d'un oeil pour ne pas lui faire peur

Comme tu as pu le voir, je ne suis pas un as en access, j'aurais même tendance à être une grosse brêle donc, tant que ça marche ...

A ma décharge, c'est la première fois que je mets le nez dans Access et jusqu'ici, mon "truc" ne fonctionne pas trop mal (cela fait quand même 1 an que ça tourne au club sans trop de problèmes).

Je dois à la vérité de dire aussi que sans ce forum, je serais toujours occupé à pédaler dans la choucroute.

Belle et bonne journée à toi

[Flup]

Le ScanCarte.set focus y est à la ligne 55 mais j'ai le problème un peu partout, le programme semble ne pas en tenir compte en sortant d'un MsgBox.

Je crois avoir vu de la documentation à ce sujet quelque part sur le site, je vais y mettre l'autre oeil

Encore merci pour ta patience et passe une très bonne journée

Flup = diminutif de Philippe en bruxellois (je me soigne )

[Arkham46]

le on error resume next ne doit pas être utilisé sur une procédure complète comme ça
il y aura d'autres bug plus tard...

le setfocus sur le scancard ne fonctionne pas?
=> comment sais-tu s'il y a une erreur avec ce "resume next"?

sinon à la suite de FindFirst, il faut tester NoMatch et pas EOF

je vois ça comme ça (j'ai pas Access ici, j'ai écris des trucs sous Excel avant de reporter dans le code initial, mais l'idée est là) :

Code :

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
Private Sub ScanCarte_AfterUpdate()
' On Error Resume Next <= ça c'est à proscrire
on error goto Gestion_erreurs
Dim rs As Object
 
Set rs = Me.Recordset.Clone
' ici je ne comprend pas l'intérêt du CStr qu'il y avait
rs.FindFirst "TMembre.[NumInscription] = " & Nz(Me![ScanCarte], 0)
' si trouvé alors
if not rs.NoMatch then 
   Me.Bookmark = rs.Bookmark
 
    If Me![DateRenouvellement] > Date Then
      'petite boule verte affichée dans le formulaire
      Ivert.Visible = True
      Evert.Visible = True
      Irouge.Visible = False
      Erouge.Visible = False
      msg = "Le membre est en ordre de cotisation. Participe-t-il au cours ?"
      Style = vbYesNo + vbQuestion + vbDefaultButton1
      title = "Carte valide"
      response = MsgBox(msg, Style, title)
        If response = vbYes Then
          'Me!Participation = -1
          Me!DerniereVisite = Date
          Me.Requery
        End If
    Else
      'petite boule rouge affichée dans le formulaire (j'aurais bien mis un klaxon mais bon...)
      Irouge.Visible = True
      Erouge.Visible = True
      Ivert.Visible = False
      Evert.Visible = False
      msg = "La carte du membre n'est plus valide."
      Style = vbOK + vbCritical
      title = "Carte non valide"
      msg = MsgBox(msg, Style, title)
    End If
    ScanCarte = ""
    ScanCarte.SetFocus
    Ivert.Visible = False
    Evert.Visible = False
    Irouge.Visible = False
    Erouge.Visible = False
else
  msgbox "Membre non trouvé!'"
endif
exit sub
Gestion_erreurs:
select case Err.number
   case 3070 ' un numéro d'erreur au hasard
      Msgbox "erreur numéro 3070"
   case 2050 ' un autre numéro d'erreur au hasard
      Msgbox "erreur numéro 2050"
   case else " autre erreur
     Msgbox "Erreur inatendue " & err.number & ", " & err.description
end select
' ferme le recordset s'il a été ouvert avant l'erreur
if not rs is nothing then rs.close
End Sub

il n'est pas utile de faire 2 requêtes
les gestion d'erreurs est à prendre ou à laisser

bon courage