Vba access,éviter message ajout enregistremen

bonjour, le code ci dessous, dans mon formulaire de presence, genere une boite de dialogue confirmant l'ajou d'une ligne dans la table Presence. Comment éviter cette boite de message et enregistrer les ajouts sans confirmation.

merci de vos réponses
---------------------------------------------------------------------------
Option Compare Database
Option Explicit

Function ThisIs()
Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend, RecDetect
C1 = 1: TDate = Me![scr1Date]
Do Until C1 = CInt(Mid(ActiveControl.Name, 3, 2))
TDate = DateAdd("d", 1, TDate)
C1 = C1 + 1
Loop

TypeAttend = DLookup("Pretype", "Presence", "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(TDate, "mm/dd/yy") & "#")
If IsNull(TypeAttend) Then
TypeAttend = 1
End If
TypeAttend = TypeAttend + 1
If TypeAttend > 1 Then
TypeAttend = 0
End If

RecDetect = DLookup("[scrStudent]", "Presence", "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(TDate, "mm/dd/yy") & "#")
If IsNull(RecDetect) Then
StrSQL = "INSERT INTO Presence ( Preenfant, Predate, Pretype ) " _
& "SELECT " & Me![scrStudent] & " AS F1, #" _
& Format(TDate, "mm/dd/yy") & "# AS F2, " & TypeAttend & " AS F3;"
DoCmd.RunSQL StrSQL
Else
StrSQL = "UPDATE Presence SET Presence.Pretype = " & TypeAttend _
& " WHERE (((Presence.Preenfant)=" & Me![scrStudent] & ") AND" _
& "((Presence.Predate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
End If
Call RefDates
End Function

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyPageDown Then
Me![scrCDate] = DateAdd("m", 1, Me![scrCDate])
End If
If KeyCode = vbKeyPageUp Then
Me![scrCDate] = DateAdd("m", -1, Me![scrCDate])
End If
Call RefDates
End Sub

Private Sub Form_Open(Cancel As Integer)
Me![scrCDate] = DateSerial(Year(Date), Month(Date), 1)
Me![scrMonth] = Format(Date, "mmmm")
Me![scrYear] = Format(Date, "yyyy")
End Sub
Sub RefDates()
Dim D1 As Variant, D2 As Integer, D3 As Integer, TypeAttend
If IsNull(Me![scrStudent]) Then
MsgBox ("Selection error.@Displaying calendar data can only be done for a specific " _
& "liste.@Select a liste and continue.")
Exit Sub
End If
Me![scrMonth] = Format(Me![scrCDate], "mmmm")
Me![scrYear] = Format(Me![scrCDate], "yyyy")
D1 = DateSerial(Year(Me![scrCDate]), Month(Me![scrCDate]), 1)
D2 = DatePart("w", D1, vbMonday)
Do Until DatePart("w", D1, vbMonday) = 1
D1 = DateAdd("d", -1, D1)
Loop
Me![scr1Date] = D1
D3 = 1
Do Until D3 > 42
Me("C" & Format(D3, "00")) = Day(D1)
If Month(D1) <> Month(Me![scrCDate]) Then
Me("C" & Format(D3, "00")).ForeColor = 8421504
Else
Me("C" & Format(D3, "00")).ForeColor = 0
'If Me(strt).ForeColor = -2147483634 Then
End If
TypeAttend = DLookup("Pretype", "Presence", "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(D1, "mm/dd/yy") & "#")
If IsNull(TypeAttend) Then
TypeAttend = 1
End If
Select Case TypeAttend
Case 0
Me("C" & Format(D3, "00")).BackColor = 12632256
Case 1
Me("C" & Format(D3, "00")).BackColor = 65280
Case 2
Me("C" & Format(D3, "00")).BackColor = 255
Case Else
Me("C" & Format(D3, "00")).BackColor = 3355443
Me("C" & Format(D3, "00")).ForeColor = 16777215
End Select
D3 = D3 + 1
D1 = DateAdd("d", 1, D1)
Loop
Me.Repaint
End Sub
Private Sub scrStudent_AfterUpdate()
Call RefDates
End Sub
Private Sub Command107_Click()
On Error GoTo Err_Command107_Click

DoCmd.Close

Exit_Command107_Click:
Exit Sub

Err_Command107_Click:
MsgBox Err.Description
Resume Exit_Command107_Click

End Sub

Private Sub Text105_BeforeUpdate(Cancel As Integer)

End Sub

16 réponses

  1. + 1 pour ggvad

    Docmd.setwarnings (True)
    Docmd.setwarnings (False)

    + 99999999^99 pour BLUX parce qu'il m'a trop aidé de nombreuses fois.
    Merci BLUX !
    8
    1. Salut,

      Le message de confirmation est généré la portion de code
      If IsNull(RecDetect) Then 
      StrSQL = "INSERT INTO Presence ( Preenfant, Predate, Pretype ) " _ 
      & "SELECT " & Me![scrStudent] & " AS F1, #" _ 
      & Format(TDate, "mm/dd/yy") & "# AS F2, " & TypeAttend & " AS F3;" 
      DoCmd.RunSQL StrSQL 
      Else 
      StrSQL = "UPDATE Presence SET Presence.Pretype = " & TypeAttend _ 
      & " WHERE (((Presence.Preenfant)=" & Me![scrStudent] & ") AND" _ 
      & "((Presence.Predate)=#" & Format(TDate, "mm/dd/yy") & "#));" 
      DoCmd.RunSQL StrSQL 
      End If 
      


      Le code utilise un string SQL (portion de code SQL) pour ajouter l'enregistrement a la table. Tu ne pourras pas suprimer le message sans réécrire toute la partie d'ajout d'enregistrement.

      Exemple:

      Dim mDb As Database
      Dim Rs As Recordset

      Set mDb = CurrentDB
      Set Rs = mDb.Openrecordset(.....)

      Rs.AddNew
      ...
      Rs.Update

      Rien n'est plus dangereux qu'une idée quand on a 
      qu'une idée
        :-)
      0
      1. Modérateur
        Ca peut marcher même sans addnew, avec une requête temporaire

        Un extrait de ce qui tourne chez moi :

            StrSql = ""
            StrSql = StrSql + "DELETE * FROM Liste_Composition "
            StrSql = StrSql + "WHERE Num_Liste = " & Liste & " AND "
            StrSql = StrSql + "Num_contenu = " & Cont & " ;"
            'MsgBox StrSql
            Set Rs = Db.CreateQueryDef("", StrSql)
            On Error Resume Next
            Rs.Execute dbFailOnError
            Select Case Err.Number
                Case 0
                Case Else
                    MsgBox Err.Number & Chr(13) & Err.Description
                    GoTo Fin:
            End Select

        A+ Blux
         "Les cons, ça ose tout.
        C'est même à ça qu'on les reconnait"
        0
    2. Modérateur
      Salut,

      il y a une option qui permet de ne pas générer ces messages :

      Menu Outils/options et l'onglet modifier/rechercher (sous ACCESS 97)possède une zone 'confirmer' ou l'on peut supprimer l'information de confirmation.

      A voir si cela t'est utile...

      A+ Blux
       "Les cons, ça ose tout.
      C'est même à ça qu'on les reconnait"
      1
      1. bonjour,
        confirmation, le message est bien issu de la chaine sql, malheuresement je ne sais pas reecrire ce bout de code, et cela malgres tes conseils.

        l'option qui permet dans access, de ne pas générer de mesage ne fonctionne pas dans ce cas!

        merci tout de même, cela ma bien aidé tout de même.
        0
        1. Si cela t'es vraiment utile, je peux modifier le code...
          Il faudra que tu le testes et m'informe de l'évolution.

          Rien n'est plus dangereux qu'une idée quand on a 
          qu'une idée
            :-)
          0
          1. bonjour, re

            ce serait super, si ca ne te demande pas trop de temps. il s'agi d'une base de données pour gerer les jours de présence f'enfant handicapé dans un centre ipro. je me suis proposé de leur faire mais je me rend compte aujourdh'uis de es limites.

            la base est fini, c'est le seul probleme qui reste. si tu le souhaite je peux te donner d'autres indications.

            merci de ta proposition.

            jack
            0
            1. WE oblige, me voila de retour.

              Començons par le commencement. TRAVAIL SUR UNE COPIE !!!!

              Commence par ajouter le code suivant (juste après "Function ThisIs()"):
              Dim mDb As Database
              Dim mRs As Recordset


              Set mDb = CurrentDb
              Set mRs = mDb.OpenRecordset("Presence",dbOpenDynaset, dbSeeChanges, dbPessimistic)

              En suite tu remplace:
              If IsNull(RecDetect) Then 
              StrSQL = "INSERT INTO Presence ( Preenfant, Predate, Pretype ) " _ 
              & "SELECT " & Me![scrStudent] & " AS F1, #" _ 
              & Format(TDate, "mm/dd/yy") & "# AS F2, " & TypeAttend & " AS F3;" 
              DoCmd.RunSQL StrSQL 
              Else 
              StrSQL = "UPDATE Presence SET Presence.Pretype = " & TypeAttend _ 
              & " WHERE (((Presence.Preenfant)=" & Me![scrStudent] & ") AND" _ 
              & "((Presence.Predate)=#" & Format(TDate, "mm/dd/yy") & "#));" 
              DoCmd.RunSQL StrSQL 
              End If 


              Par:

              If IsNull(RecDetect) Then
              mRs.AddNNew
              mRs("Preenfant")=Me![scrStudent]
              mRs("Predate")=Me![TDate]
              mRs("Pretype")=Me![TypeAttend]
              mRs.Update
              mRs.Close
              Else
              mRs.FindFirst "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(TDate, "mm/dd/yy") & "#"
              mRs.Edit
              mRs("Pretype")=Me![TypeAttend]
              mRs.Update
              End If

              Essaye et tiens moi au courant.

              Rien n'est plus dangereux qu'une idée quand on a 
              qu'une idée
                :-)
              0
              1. bonjour et merci de ton aide,

                j'ai suivi trs conseil, sur une copie, bien sur, j'ai un message d'erreur au demarage de la fonction "Function ThisIs()"

                "erreur decompilation, type défini par l'utilisateur non défini ?"

                "mDb As Database" reste en surbrillance !

                voici ce que donne la fonction réecrite :
                Function ThisIs()
                Dim mDb As Database
                Dim mRs As Recordset

                Set mDb = CurrentDb
                Set mRs = mDb.OpenRecordset("Presence", dbOpenDynaset, dbSeeChanges, dbPessimistic)

                Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend, RecDetect
                C1 = 1: TDate = Me![scr1Date]
                Do Until C1 = CInt(Mid(ActiveControl.Name, 3, 2))
                TDate = DateAdd("d", 1, TDate)
                C1 = C1 + 1
                Loop

                TypeAttend = DLookup("Pretype", "Presence", "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(TDate, "mm/dd/yy") & "#")
                If IsNull(TypeAttend) Then
                TypeAttend = 0
                End If
                TypeAttend = TypeAttend + 1
                If TypeAttend > 3 Then
                TypeAttend = 0
                End If

                RecDetect = DLookup("[scrStudent]", "Presence", "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(TDate, "mm/dd/yy") & "#")
                If IsNull(RecDetect) Then
                mRs.AddNNew
                mRs("Preenfant") = Me![scrStudent]
                mRs("Predate") = Me![TDate]
                mRs("Pretype") = Me![TypeAttend]
                mRs.Update
                mRs.Close
                Else
                mRs.FindFirst "[Preenfant] = " & Me![scrStudent] & " AND [Predate] = #" & Format(TDate, "mm/dd/yy") & "#"
                mRs.Edit
                mRs("Pretype") = Me![TypeAttend]
                mRs.Update
                End If

                Call RefDates
                End Function

                qu'en pense tu ?
                0
            2. Alors,...

              Tu utilises Access 2000?
              Si c'est le cas, le problème ce situe là. J'ai codé pour Access 97.
              Access 2000 ne reconnais plus le type "Database".
              Sur ce, je ne pourrai pas t'aider.

              Blux!!!!! A l'aide

              Rien n'est plus dangereux qu'une idée quand on a 
              qu'une idée
                :-)
              0
              1. Modérateur
                Blux!!!!! A l'aide
                'sais pas !
                chus en 97 :-)))

                A+ Blux
                 "Les cons, ça ose tout.
                C'est même à ça qu'on les reconnait"
                0
            3. J'ai obtenu une réponse sur un autre site:

              Il faut que tu installe les bibliothèques ADODB et DAO.
              Dans l'éditeur de code VBA,

              Menu Outils -> Références

              Ensuites tu coches et décoches les bibliothèques désirées ou non désirées.

              J'espère que cela suffira

              Rien n'est plus dangereux qu'une idée quand on a 
              qu'une idée
                :-)
              0
              1. super!

                ça marche impec !

                merci à tous ceux qui ont participé !!

                jack
                0
            4. merci quand même de ton aide, à charge de revanche !

              a+
              0
              1. je ne comprend pas bien les regles de validation dans access
                càd quand est il faut utiser les guillemet "" ou double quillemets""""" ou '' ou &
                merci
                0
                1. Bonjour

                  il faut ajouter
                  docmd setwarning false
                  0
                  1. 'Décoche la case CONFIRMER REQUETES ACTION
                    VarRequeteAction = Application.GetOption("Confirmer Requêtes action")
                    If VarRequeteAction = -1 Then Application.SetOption "Confirmer Requêtes action", 0

                    'Décoche MODIFICATION DES ENREGISTREMENTS
                    VarConfirmerEnregistrement = Application.GetOption("Modification des enregistrements")
                    If VarConfirmerEnregistrement = -1 Then Application.SetOption "Modification des enregistrements", 0
                    >

                    Sinon le faire manuellement OUTILS/OPTION Modifier/RECHERCHER et décocher "Confirmer Requêtes action" et ou Modification des enregistrements
                    3
                    1. EXCELLENT, le code indiqué par didier :

                      'Décoche la case CONFIRMER REQUETES ACTION
                      VarRequeteAction = Application.GetOption("Confirmer Requêtes action")
                      If VarRequeteAction = -1 Then Application.SetOption "Confirmer Requêtes action", 0

                      'Décoche MODIFICATION DES ENREGISTREMENTS
                      VarConfirmerEnregistrement = Application.GetOption("Modification des enregistrements")
                      If VarConfirmerEnregistrement = -1 Then Application.SetOption "Modification des enregistrements", 0

                      à base de 'Application.GetOption' et 'Application.SetOption'

                      UN GRAND MERCI
                      0