Sos vba access, confirmation ajouts enregistr
adnform
-
Utilisateur anonyme -
Utilisateur anonyme -
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
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
A voir également:
- Sos vba access, confirmation ajouts enregistr
- Confirmation de lecture whatsapp - Guide
- Confirmation de lecture gmail - Guide
- Sms code de confirmation facebook sans demande ✓ - Forum Facebook
- Access runtime ✓ - Forum Access
- J'ai reçu un code de confirmation Facebook sans raison ✓ - Forum Réseaux sociaux
3 réponses
A ce que je vois, vous tentez d'utiliser une requête SQL Action de type Ajout et Mise à jour. Etant donné que ces requêtes modifient les données d'une ou plusieurs tables, Access demandera par défaut une confirmation. Pour éviter la confirmation de chaque action, passez dans le menu Outils et choisissez la commande Options. Passez dans l'onglet Modifier (si je ne m'abuse) ert enlevez les confirmations sur les requêtes actions.
Je pense que cela suffira sinon faites moi signe ;-)
Je pense que cela suffira sinon faites moi signe ;-)
Bonjours adnform,
Il me semble que tu avais poser la question il y a quelques temps et que le problème était résolu...
Voir ici
http://www.commentcamarche.net/forum/affich-489610-vba-access-%E9viter-message-ajout-enregistremen
Rien n'est plus dangereux qu'une idée quand on a
qu'une idée :-)
Il me semble que tu avais poser la question il y a quelques temps et que le problème était résolu...
Voir ici
http://www.commentcamarche.net/forum/affich-489610-vba-access-%E9viter-message-ajout-enregistremen
Rien n'est plus dangereux qu'une idée quand on a
qu'une idée :-)