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
| 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
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] )"
'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