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 61 62 63 64 65 66 67 68 69 70
| Private Sub Archiver_Accueillis_SQL_Click()
Dim Message1, Style1, Titre1
Dim Message2, Style2, Titre2
Dim Message3, Style3, Titre3
'Msgbox Ok + Non
Message1 = "Vous êtes sur le point d'archiver les accueillis, cette opération est irréversible." & vbLf & vbLf & "Veuillez être sûre que toutes les conditions pour l'archivage soient renseigner sur les fiches détails de l'accueilli. (Date de sortie et Motif de Sortie)." & vbLf & vbLf & "Pour archiver, cliquez sur OUI sinon cliquez sur NON."
Style1 = vbYesNo
Titre1 = "Procédure d'archivage"
'MsgBox Message1, Style1, Titre1
Select Case MsgBox(Message1, Style1, Titre1)
Case vbYes
'procédure si click sur Ok
DoCmd.SetWarnings False
Dim Tbl As String, Tbl2 As String, Motif_Sortie As String, rs As DAO.Recordset
Dim db As String
Dim SQL As String
Dim Nb_Archives As String
db = CurrentDb
Tbl = "Archives_Accueillis_Simples"
Tbl2 = "Accueillis Simples"
' Exécution de la requête
'On sélectionne les accueillis correspondant aux critères d'archivages
SQL = "SELECT [" & Tbl2 & "].[ID], [" & Tbl2 & "].[ID Accueilli simple],"
SQL = SQL & "[" & Tbl2 & "].[Civilité],"
SQL = SQL & "[" & Tbl2 & "].[Prénom], [" & Tbl2 & "].[Nom], [" & Tbl2 & "].[Date de naissance],"
SQL = SQL & "[" & Tbl2 & "].[Département d'origine], [" & Tbl2 & "].[Date d'entrée],"
SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].[Id_Motif]"
SQL = SQL & " FROM tbl_Motif_Sortie INNER JOIN [" & Tbl2 & "] ON tbl_Motif_Sortie.Id_Motif = [" & Tbl2 & "].Id_Motif"
SQL = SQL & " GROUP BY [" & Tbl2 & "].ID, [" & Tbl2 & "].[ID Accueilli simple],"
SQL = SQL & "[" & Tbl2 & "].Civilité, [" & Tbl2 & "].Prénom, [" & Tbl2 & "].Nom,"
SQL = SQL & "[" & Tbl2 & "].[Date de naissance], [" & Tbl2 & "].[Date d'entrée],"
SQL = SQL & "[" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif"
SQL = SQL & " HAVING ((([" & Tbl2 & "].[Date de sortie])=True)"
SQL = SQL & " And ([" & Tbl2 & "].[Id_Motif] Between 1 And 10)) OR (([" & Tbl2 & "].[Id_Motif] Between 1 And 10));"
CurrentDb.Execute SQL ' TU FAIS UNE REQUETE SELECTION DONC NORMAL SI ON N'UTILISE PAS EXECUTE
' JE NE COMPRENDS PAS L'UTILITE DE LA LIGNE DE CODE PRECEDENTE Je sélectionne les lignes ou la date de sortie n'est pas vide ainsi que le motif de sortie. Il y a 10 motifs de sorties dans la table Motif_Sortie. Si les deux conditions sont réunies, on archive.
Nb_Archives = NbRecords(SQL)
'On ajoute la sélection dans la table d'archives
CurrentDb.Execute "INSERT INTO" & Tbl & "( ID, [ID Accueilli simple], Civilité, Prénom, Nom, [Date de naissance], [Date d'entrée], [Date de sortie], [Motif de sortie] )"
' LA LIGNE DE CODE PRECEDETE EST INCOMPLETE PARCE QUE LES VALEURS A AJOUTER NE SONT PAS DEFINIES DANS LE CODE En effet, maintenant je comprend pourquoi l'assitant requete ajout rajoute le insert avec la selection...
'On supprime la sélection de la table d'Accueilli
SQL = "DELETE [" & Tbl2 & "].*, [" & Tbl2 & "].[Date de sortie], [" & Tbl2 & "].Id_Motif FROM " & Tbl2
SQL = SQL & "WHERE ((([" & Tbl2 & "].[Date de sortie])=True) AND (([" & Tbl2 & "].Id_Motif) Between 1 And 10));"
db.Execute SQL
Message2 = "L'archivage est terminé." & vbLf & vbLf & "Il y a eu " & Nb_Archives & " accueillis d'archivé. Vous les retrouverez sur la liste des archives."
Style2 = vbOKOnly
Titre2 = "Archivage terminé"
MsgBox Message2, Style2, Titre2
DoCmd.SetWarnings True
Case vbNo
'procédure si click sur Non
Message3 = "L'archivage est annulé."
Style3 = vbOKOnly
Titre3 = "Archivage Annulé par l'utilisateur"
MsgBox Message3, Style3, Titre3
End Select
End Sub |
Partager