Option Compare Database Sub testMSG() Call CreerMsg(12, , "T22") End Sub Public Function AfficherMsgProgression(titre As String, Optional ByVal msg As String) DoCmd.Hourglass True DoCmd.OpenForm "msg_traitement" forms![msg_traitement].[txt_titre].Caption = titre If Len(msg) > 0 Then forms![msg_traitement].[txt_msg].Caption = msg Else forms![msg_traitement].[txt_msg].Visible = False End If 'largeur_prog = 5137 forms![msg_traitement].prog.Width = 1 End Function Public Function MajMsgProgression(prog As Integer, Total As Integer) Dim taux As Single If Total = 0 Then Exit Function If CurrentProject.AllForms("msg_traitement").IsLoaded = False Then Exit Function taux = prog / Total forms![msg_traitement].prog.Width = 5137 * taux If prog >= Total Then DoCmd.Hourglass False DoCmd.Close acForm, "msg_traitement" End If End Function Public Function CreerMsg(code As Integer, Optional ByVal IDSuivi As Double, Optional ByVal AutreID As String, Optional ByVal val As String) 'cette fonction renvoie les messages de suivi stockés dans la table tbl_msg 'l'IDSuivi permet l'identification des lignes de tbl_SuiviRH 'la variable AutreID représente le code d'un agent, le nom d'un barème, ou tout autre identifiant nécessaire à un message 'la variable val fournit éventuellement une indication complémentaire Dim msg As String Dim rs As DAO.Recordset Select Case code Case 1 'import If Nz(IDSuivi, 0) > 0 Then Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_SuiviRH WHERE [IDSuivi]=" & IDSuivi & ";") If rs.RecordCount = 0 Or rs.RecordCount > 1 Then msg = "Nouvelles données importées" Else msg = "Import des données de " & DLookup("Nom", "r_agents", "[CodeAgent]='" & rs![CodeAgent] & "'") & _ " pour le mois de " & MonthName(rs![moisRH]) & " " & rs![anneeRH] End If Else msg = "Nouvelles données importées" End If Case 2 'validation If Nz(IDSuivi, 0) > 0 Then Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_SuiviRH WHERE [IDSuivi]=" & IDSuivi & ";") If rs.RecordCount = 0 Or rs.RecordCount > 1 Then msg = "Des données ont été validées" Else msg = "Validation des données de " & DLookup("Nom", "r_agents", "[CodeAgent]='" & rs![CodeAgent] & "'") & _ " pour le mois de " & MonthName(rs![moisRH]) & " " & rs![anneeRH] End If Else msg = "Des données ont été validées" End If Case 3 're-traitement des données If Nz(IDSuivi, 0) > 0 Then Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_SuiviRH WHERE [IDSuivi]=" & IDSuivi & ";") If rs.RecordCount = 0 Or rs.RecordCount > 1 Then msg = "Des données ont été réanalysées" Else msg = "Ré-analyse des données de " & DLookup("Nom", "r_agents", "[CodeAgent]='" & rs![CodeAgent] & "'") & _ " pour le mois de " & MonthName(rs![moisRH]) & " " & rs![anneeRH] End If Else msg = "Des données ont été réanalysées" End If Case 4 'formulaires edités If Nz(IDSuivi, 0) > 0 Then Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_SuiviRH WHERE [IDSuivi]=" & IDSuivi & ";") If rs.RecordCount = 0 Or rs.RecordCount > 1 Then msg = "Formulaires edités" Else msg = "Edition des formulaires de " & DLookup("Nom", "r_agents", "[CodeAgent]='" & rs![CodeAgent] & "'") & _ " pour le mois de " & MonthName(rs![moisRH]) & " " & rs![anneeRH] End If Else msg = "Formulaires edités" End If Case 11 'barème mise à jour If Len(Nz(AutreID, "")) > 0 Then If Len(Nz(val, "")) > 0 Then msg = "Le barème " & AutreID & " a été mis à jour (CodePeriode " & val & ")" Else msg = "Le barème " & AutreID & " a été mis à jour" End If Else msg = "Un barème a été mis à jour" End If Case 12 'agent mis à jour If Len(Nz(AutreID, "")) > 0 Then If Len(Nz(val, "")) > 0 Then msg = "Les données de l'agent " & DLookup("Nom", "r_agents", "[CodeAgent]='" & AutreID & "'") & " ont été mises à jour (CodePeriode " & val & ")" Else msg = "Les données de l'agent " & DLookup("Nom", "r_agents", "[CodeAgent]='" & AutreID & "'") & " ont été mises à jour" End If Else msg = "Les données d'un agent ont été mises à jour" End If Case 13 'agent créé If Len(Nz(AutreID, "")) > 0 Then msg = "L'agent " & DLookup("Nom", "r_agents", "[CodeAgent]='" & AutreID & "'") & " a été créé ('" & AutreID & "')" Else msg = "Un agent a été créé" End If Case 21 'mise à jour de l'appli msg = "L'application a été mise à jour" End Select Call NveauMsg(msg) CreerMsg = msg End Function Public Sub NveauMsg(msg As String) Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("tbl_msg") rs.AddNew rs![msg] = msg rs![DateMsg] = Now() rs![User] = Environ("username") rs.Update rs.Close End Sub