Private Sub CmdSave_Click()
[Link] = False
[Link] = False
[Link] = xlCalculationManual
On Error GoTo GestionErreur
Dim cmd As [Link]
Dim rs As [Link]
Dim SQL As String
Dim IDFrais As Long
Dim RecuExiste As Long
'==============================
' Ouvrir la connexion Access
'==============================
If Conn Is Nothing Then
OuvrirConnexionAccess
ElseIf [Link] = 0 Then
OuvrirConnexionAccess
End If
'==============================
' Vérification des champs
'==============================
If Trim([Link]) = "" Then
MsgBox "Veuillez sélectionner le matricule.", vbExclamation
[Link]
Exit Sub
End If
If Trim([Link]) = "" Then
MsgBox "Veuillez sélectionner le type de frais.", vbExclamation
[Link]
Exit Sub
End If
If Trim([Link]) = "" Then
MsgBox "Veuillez sélectionner le mode de paiement.", vbExclamation
[Link]
Exit Sub
End If
If Trim([Link]) = "" Then
MsgBox "Veuillez saisir la date de paiement.", vbExclamation
[Link]
Exit Sub
End If
If Trim([Link]) = "" Then
MsgBox "Le numéro de reçu est vide.", vbCritical
Exit Sub
End If
If NumeroRecuExiste([Link]) Then
MsgBox "Ce numéro de reçu existe déjà.", vbExclamation
Exit Sub
End If
'==============================
' Recherche de l'IDFrais
'==============================
SQL = "SELECT IDFrais FROM Frais " & _
"WHERE NomFrais='" & Replace([Link], "'", "''") & "'"
Set rs = New [Link]
[Link] SQL, Conn, adOpenForwardOnly, adLockReadOnly
If [Link] Then
MsgBox "Le type de frais sélectionné n'existe pas.", vbCritical
[Link]
Set rs = Nothing
Exit Sub
End If
IDFrais = rs!IDFrais
[Link]
Set rs = Nothing
'==============================
' Préparation de la commande
'==============================
Set cmd = New [Link]
With cmd
.ActiveConnection = Conn
.CommandText = _
"INSERT INTO Paiements " & _
"(Matricule,IDFrais,MontantUSD,MontantCDF," & _
"MontantEnLettres,DatePaiement,ModePaiement," & _
"Motif,Promotion,NumeroRecu,IDUtilisateur, Faculté)" & _
" VALUES (?,?,?,?,?,?,?,?,?,?,?)"
.CommandText = _
"INSERT INTO Paiements " & _
"(Matricule,IDFrais,MontantUSD,MontantCDF," & _
"MontantEnLettres,DatePaiement,ModePaiement," & _
"Motif,Promotion,NumeroRecu,IDUtilisateur, Faculté)" & _
" VALUES (?,?,?,?,?,?,?,?,?,?,?)"
'==============================
' Paramètres
'==============================
.[Link] .CreateParameter("p1", adVarChar, adParamInput, 50,
[Link])
.[Link] .CreateParameter("p2", adInteger, adParamInput, , IDFrais)
.[Link] .CreateParameter("p3", adDouble, adParamInput, , val([Link]))
.[Link] .CreateParameter("p4", adDouble, adParamInput, , val([Link]))
.[Link] .CreateParameter("p5", adVarChar, adParamInput, 255, [Link])
.[Link] .CreateParameter("p6", adDate, adParamInput, , CDate([Link]))
.[Link] .CreateParameter("p7", adVarChar, adParamInput, 50,
[Link])
.[Link] .CreateParameter("p8", adVarChar, adParamInput, 100, [Link])
.[Link] .CreateParameter("p9", adVarChar, adParamInput, 50, [Link])
.[Link] .CreateParameter("p10", adVarChar, adParamInput, 50, [Link])
.[Link] .CreateParameter("p11", adInteger, adParamInput, , IDUtilisateurConnecte)
.[Link] .CreateParameter("p12", adInteger, adParamInput, 50, TextFaculté.Value)
.Execute
End With
'==============================
' Libération des objets
'==============================
Set cmd = Nothing
'==============================
' Confirmation
'==============================
MsgBox "Paiement enregistré avec succès !" & vbCrLf & _
"Numéro de reçu : " & [Link], _
vbInformation, "UPCC"
'==============================
' Réinitialisation du formulaire
'==============================
[Link] = ""
[Link] = ""
TextFaculté.Value = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link] = ""
[Link]
Exit Sub
'==============================
' Gestion des erreurs
'==============================
GestionErreur:
MsgBox "Erreur N° " & [Link] & vbCrLf & _
[Link], vbCritical, "Erreur"
If Not rs Is Nothing Then
If [Link] = adStateOpen Then [Link]
End If
Set rs = Nothing
Set cmd = Nothing
[Link] = True
[Link] = True
[Link] = xlCalculationAutomatic
End Sub