Vba access,éviter message ajout enregistremen

Fermé
adnform - 20 nov. 2003 à 09:44
 IDO - 18 janv. 2011 à 09:07
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 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
'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
blux Messages postés 26490 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 18 novembre 2024 3 316
20 nov. 2003 à 11:57
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
Utilisateur anonyme
20 nov. 2003 à 10:17
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
blux Messages postés 26490 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 18 novembre 2024 3 316
20 nov. 2003 à 17:03
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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
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
Utilisateur anonyme
20 nov. 2003 à 15:53
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
adnorm Messages postés 1 Date d'inscription jeudi 20 novembre 2003 Statut Membre Dernière intervention 20 novembre 2003
20 nov. 2003 à 16:20
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
Utilisateur anonyme
24 nov. 2003 à 10:25
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
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
Utilisateur anonyme
25 nov. 2003 à 09:12
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
blux Messages postés 26490 Date d'inscription dimanche 26 août 2001 Statut Modérateur Dernière intervention 18 novembre 2024 3 316
25 nov. 2003 à 09:18
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
Utilisateur anonyme
25 nov. 2003 à 11:06
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
super!

ça marche impec !

merci à tous ceux qui ont participé !!

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

a+
0
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
ggvad Messages postés 2 Date d'inscription vendredi 24 novembre 2006 Statut Membre Dernière intervention 24 novembre 2006
24 nov. 2006 à 19:18
Bonjour

il faut ajouter
docmd setwarning false
0
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
Oui MERCI!
0
+1 pour ggvad ca marche
0