Version =20 VersionRequired =20 Begin Form RecordSelectors = NotDefault MaxButton = NotDefault MinButton = NotDefault ControlBox = NotDefault AutoCenter = NotDefault NavigationButtons = NotDefault DividingLines = NotDefault AllowDesignChanges = NotDefault DefaultView =0 ScrollBars =0 PictureAlignment =2 DatasheetGridlinesBehavior =3 GridY =10 Width =10714 DatasheetFontHeight =11 ItemSuffix =16 Right =9030 Bottom =12345 DatasheetGridlinesColor =14806254 RecSrcDt = Begin 0x98cd09ff0f38e440 End OnCurrent ="[Event Procedure]" DatasheetFontName ="Calibri" PrtMip = Begin 0x6801000068010000680100006801000000000000201c0000e010000001000000 , 0x010000006801000000000000a10700000100000001000000 End FilterOnLoad =0 ShowPageMargins =0 DisplayOnSharePointSite =1 DatasheetAlternateBackColor =15921906 DatasheetGridlinesColor12 =0 FitToScreen =1 DatasheetBackThemeColorIndex =1 BorderThemeColorIndex =3 ThemeFontIndex =1 ForeThemeColorIndex =0 AlternateBackThemeColorIndex =1 AlternateBackShade =95.0 Begin Begin Label BackStyle =0 FontSize =11 FontName ="Calibri" ThemeFontIndex =1 BackThemeColorIndex =1 BorderThemeColorIndex =0 BorderTint =50.0 ForeThemeColorIndex =0 ForeTint =50.0 GridlineThemeColorIndex =1 GridlineShade =65.0 End Begin CommandButton Width =1701 Height =283 FontSize =11 FontWeight =400 FontName ="Calibri" ForeThemeColorIndex =0 ForeTint =75.0 GridlineThemeColorIndex =1 GridlineShade =65.0 UseTheme =1 Shape =1 Gradient =12 BackThemeColorIndex =4 BackTint =60.0 BorderLineStyle =0 BorderColor =16777215 BorderThemeColorIndex =4 BorderTint =60.0 ThemeFontIndex =1 HoverThemeColorIndex =4 HoverTint =40.0 PressedThemeColorIndex =4 PressedShade =75.0 HoverForeThemeColorIndex =0 HoverForeTint =75.0 PressedForeThemeColorIndex =0 PressedForeTint =75.0 End Begin CheckBox BorderLineStyle =0 LabelX =230 LabelY =-30 BorderThemeColorIndex =1 BorderShade =65.0 GridlineThemeColorIndex =1 GridlineShade =65.0 End Begin Subform BorderLineStyle =0 Width =1701 Height =1701 BorderThemeColorIndex =1 GridlineThemeColorIndex =1 GridlineShade =65.0 BorderShade =65.0 ShowPageHeaderAndPageFooter =1 End Begin FormHeader Height =5986 BackColor =13611711 Name ="EntêteFormulaire" AlternateBackThemeColorIndex =1 AlternateBackShade =95.0 Begin Begin Label OverlapFlags =85 TextAlign =2 Left =850 Top =170 Width =3232 Height =340 FontSize =13 FontWeight =700 BorderColor =8355711 Name ="Étiquette0" Caption ="Outils d'Administration" GridlineColor =10921638 LayoutCachedLeft =850 LayoutCachedTop =170 LayoutCachedWidth =4082 LayoutCachedHeight =510 ForeTint =100.0 End Begin CommandButton OverlapFlags =85 Left =283 Top =170 Width =501 Height =336 ForeColor =4210752 Name ="Commande1" Caption ="Commande1" ControlTipText ="Fermer formulaire" GridlineColor =10921638 OnClickEmMacro = Begin Version =196611 ColumnsShown =8 Begin Action ="Close" Argument ="-1" Argument ="" Argument ="0" End Begin Comment ="_AXL:\015\012<" End Begin Comment ="_AXL:Statements>" End End ImageData = Begin 0x2800000010000000100000000100200000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000010081080 , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x000000000000000000000000000000000000000040485020100810e0104050ff , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x0000000000000000000000000000000040404080405860ff106890ff2080a0f0 , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x0000000000000000607070ff80a0b0ff4080a0ff20a0d0ff40a8e0ff2078a0ff , 0x101020ff101020ff000000000000000000000000000000000000000000000000 , 0x0000000000000000708890ffa0d8f0ff60d0ffff50c0f0ff30a8e0ff1080b0ff , 0xe0d8d0ff102020ff000000000000000000000000000000000000000000000000 , 0x0000000000000000708890ffb0e8f0ff80e0ffff60c8f0ff50b8f0ff1088c0ff , 0xf0d8d0ff202830ff000000000000000090482030904820ff0000000000000000 , 0x0000000000000000808890ffb0e8f0ff80e0ffff60d0ffff404050ff1090c0ff , 0xf0e0d0ff303840ff0000000090482030a05030ffa05020ff0000000000000000 , 0x00000000000000008090a0ffc0f0ffff90e0ffff70d8ffff60c8f0ff0090c0ff , 0xf0e0e0ff404050ff90482030a05030ffd07840ffb05830ffa05020ffa04820ff , 0x904820ff904820ff8090a0ffc0f0ffffa0e8ffff80d8ffff70d0f0ff40b0e0ff , 0xf0e8e0ff605050ffa05830ffe08860fff09060fff08850ffe07850ffd07040ff , 0xb06840ff904820ff8098a0ffc0f0ffffa0e8ffff90e8ffff80e0ffff80b8d0ff , 0xf0e8e0ffe09870ffffc0a0ffffb090ffffa070fff09060fff08850ffe07850ff , 0xd07040ffa05020ff8098a0ffc0f0ffffc0f8ffffa0e0f0ff90a8b0ffc0c8d0ff , 0xf0f0e0ff908080fff0a070ffffc0a0ffffb090ffffb090ffffa880fff0a080ff , 0xe09870ffb05030ff90a0a0ffe0f8ffffb0c8d0ff90a0b0fff0f0f0fffff8f0ff , 0xf0f0f0ff607080ffe0987050f0a070ffffc0a0ffd06830ffe09870ffe09060ff , 0xe08860ffe08050ff90a0b0ff90a8b0ffc0c8d0ffffffffffffffffffffffffff , 0xffffffff708890ff00000000e0987050e09870ffd07040ff0000000000000000 , 0x000000000000000090a0b0ff90a0b0ff90a0b0ff90a0b0ff90a0a0ff8098a0ff , 0x8098a0ff9098a0ff0000000000000000e0987050e09870ff0000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x0000000000000000000000000000000000000000000000000000000000000000 , 0x0000000000000000 End LayoutCachedLeft =283 LayoutCachedTop =170 LayoutCachedWidth =784 LayoutCachedHeight =506 Gradient =0 BackColor =16183539 BackThemeColorIndex =-1 BackTint =100.0 BorderColor =12029087 BorderThemeColorIndex =-1 BorderTint =100.0 HoverColor =15060409 PressedColor =9592887 HoverForeColor =4210752 PressedForeColor =4210752 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =1 WebImagePaddingBottom =1 Overlaps =1 End Begin CheckBox OverlapFlags =85 Left =283 Top =3039 Width =340 Height =283 ColumnOrder =0 TabIndex =1 BorderColor =10921638 Name ="AvertSQL" AfterUpdate ="[Event Procedure]" OnClick ="[Event Procedure]" GridlineColor =10921638 LayoutCachedLeft =283 LayoutCachedTop =3039 LayoutCachedWidth =623 LayoutCachedHeight =3322 Begin Begin Label OverlapFlags =247 Left =512 Top =3004 Width =4245 Height =555 BorderColor =8355711 Name ="Étiquette3" Caption ="Activer / Désactiver les avertissements SQL (lors de mises à jour, suppressions." "..)" GridlineColor =10921638 LayoutCachedLeft =512 LayoutCachedTop =3004 LayoutCachedWidth =4757 LayoutCachedHeight =3559 ForeTint =100.0 End End End Begin CommandButton OverlapFlags =85 Left =510 Top =793 Width =4245 Height =397 TabIndex =2 ForeColor =16777215 Name ="Commande4" Caption ="Ouvrir les paramètres utilisateurs" OnClick ="[Event Procedure]" LeftPadding =90 TopPadding =45 RightPadding =105 BottomPadding =150 GridlineColor =10921638 LayoutCachedLeft =510 LayoutCachedTop =793 LayoutCachedWidth =4755 LayoutCachedHeight =1190 ForeThemeColorIndex =1 ForeTint =100.0 Gradient =25 BackColor =10642560 BackThemeColorIndex =7 BackTint =100.0 BorderColor =10642560 BorderThemeColorIndex =7 BorderTint =100.0 HoverColor =11895705 HoverThemeColorIndex =7 HoverTint =80.0 PressedColor =8605542 PressedThemeColorIndex =7 PressedShade =80.0 HoverForeThemeColorIndex =1 HoverForeTint =100.0 PressedForeThemeColorIndex =1 PressedForeTint =100.0 Shadow =-1 QuickStyle =33 QuickStyleMask =-1 WebImagePaddingLeft =2 WebImagePaddingTop =2 WebImagePaddingRight =2 WebImagePaddingBottom =2 Overlaps =1 End Begin CommandButton OverlapFlags =85 Left =510 Top =1586 Width =4245 Height =397 TabIndex =3 ForeColor =16777215 Name ="Commande5" Caption ="Droits d'accès" OnClick ="[Event Procedure]" LeftPadding =60 RightPadding =75 BottomPadding =120 GridlineColor =10921638 LayoutCachedLeft =510 LayoutCachedTop =1586 LayoutCachedWidth =4755 LayoutCachedHeight =1983 ForeThemeColorIndex =1 ForeTint =100.0 Gradient =25 BackColor =10642560 BackThemeColorIndex =7 BackTint =100.0 BorderColor =10642560 BorderThemeColorIndex =7 BorderTint =100.0 HoverColor =11895705 HoverThemeColorIndex =7 HoverTint =80.0 PressedColor =8605542 PressedThemeColorIndex =7 PressedShade =80.0 HoverForeThemeColorIndex =1 HoverForeTint =100.0 PressedForeThemeColorIndex =1 PressedForeTint =100.0 Shadow =-1 QuickStyle =33 QuickStyleMask =-1 WebImagePaddingTop =1 Overlaps =1 End Begin CommandButton OverlapFlags =85 Left =510 Top =2323 Width =4245 Height =397 TabIndex =4 ForeColor =16777215 Name ="Commande6" Caption ="Suivi des versions" OnClick ="[Event Procedure]" LeftPadding =60 RightPadding =75 BottomPadding =120 GridlineColor =10921638 LayoutCachedLeft =510 LayoutCachedTop =2323 LayoutCachedWidth =4755 LayoutCachedHeight =2720 ForeThemeColorIndex =1 ForeTint =100.0 Gradient =25 BackColor =10642560 BackThemeColorIndex =7 BackTint =100.0 BorderColor =10642560 BorderThemeColorIndex =7 BorderTint =100.0 HoverColor =11895705 HoverThemeColorIndex =7 HoverTint =80.0 PressedColor =8605542 PressedThemeColorIndex =7 PressedShade =80.0 HoverForeThemeColorIndex =1 HoverForeTint =100.0 PressedForeThemeColorIndex =1 PressedForeTint =100.0 Shadow =-1 QuickStyle =33 QuickStyleMask =-1 WebImagePaddingTop =1 Overlaps =1 End Begin CommandButton OverlapFlags =85 Left =510 Top =4422 Width =4256 Height =396 TabIndex =5 ForeColor =16777215 Name ="ImportPDA" Caption ="Import Direct depuis PDA" OnClick ="[Event Procedure]" LeftPadding =60 RightPadding =75 BottomPadding =120 GridlineColor =10921638 LayoutCachedLeft =510 LayoutCachedTop =4422 LayoutCachedWidth =4766 LayoutCachedHeight =4818 ForeThemeColorIndex =1 ForeTint =100.0 Gradient =25 BackColor =10642560 BackThemeColorIndex =7 BackTint =100.0 BorderColor =10642560 BorderThemeColorIndex =7 BorderTint =100.0 HoverColor =11895705 HoverThemeColorIndex =7 HoverTint =80.0 PressedColor =8605542 PressedThemeColorIndex =7 PressedShade =80.0 HoverForeThemeColorIndex =1 HoverForeTint =100.0 PressedForeThemeColorIndex =1 PressedForeTint =100.0 Shadow =-1 QuickStyle =33 QuickStyleMask =-1 WebImagePaddingTop =1 End Begin CommandButton OverlapFlags =85 Left =510 Top =3775 Width =4245 Height =397 TabIndex =6 ForeColor =16777215 Name ="ToutImpr" Caption ="Tout Imprimer*" OnClick ="[Event Procedure]" LeftPadding =60 RightPadding =75 BottomPadding =120 GridlineColor =10921638 LayoutCachedLeft =510 LayoutCachedTop =3775 LayoutCachedWidth =4755 LayoutCachedHeight =4172 ForeThemeColorIndex =1 ForeTint =100.0 Gradient =25 BackColor =10642560 BackThemeColorIndex =7 BackTint =100.0 BorderColor =10642560 BorderThemeColorIndex =7 BorderTint =100.0 HoverColor =11895705 HoverThemeColorIndex =7 HoverTint =80.0 PressedColor =8605542 PressedThemeColorIndex =7 PressedShade =80.0 HoverForeThemeColorIndex =1 HoverForeTint =100.0 PressedForeThemeColorIndex =1 PressedForeTint =100.0 Shadow =-1 QuickStyle =33 QuickStyleMask =-1 WebImagePaddingTop =1 End Begin CommandButton OverlapFlags =85 Left =510 Top =5106 Width =4252 Height =393 TabIndex =7 ForeColor =16777215 Name ="PeripleToutExporter" Caption ="PERIPLE: Tout Exporter" OnClick ="[Event Procedure]" LeftPadding =60 RightPadding =75 BottomPadding =120 GridlineColor =10921638 LayoutCachedLeft =510 LayoutCachedTop =5106 LayoutCachedWidth =4762 LayoutCachedHeight =5499 ForeThemeColorIndex =1 ForeTint =100.0 Gradient =25 BackColor =10642560 BackThemeColorIndex =7 BackTint =100.0 BorderColor =10642560 BorderThemeColorIndex =7 BorderTint =100.0 HoverColor =11895705 HoverThemeColorIndex =7 HoverTint =80.0 PressedColor =8605542 PressedThemeColorIndex =7 PressedShade =80.0 HoverForeThemeColorIndex =1 HoverForeTint =100.0 PressedForeThemeColorIndex =1 PressedForeTint =100.0 Shadow =-1 QuickStyle =33 QuickStyleMask =-1 WebImagePaddingTop =1 End Begin Label Visible = NotDefault OverlapFlags =85 TextAlign =2 Left =625 Top =5703 Width =3911 Height =283 BorderColor =8355711 Name ="txt_prog" Caption ="..." GridlineColor =10921638 LayoutCachedLeft =625 LayoutCachedTop =5703 LayoutCachedWidth =4536 LayoutCachedHeight =5986 ForeTint =100.0 End End End Begin Section Height =0 BackColor =13611711 Name ="Détail" AlternateBackColor =15921906 AlternateBackThemeColorIndex =1 AlternateBackShade =95.0 End Begin FormFooter Height =396 BackColor =13611711 Name ="PiedFormulaire" AlternateBackThemeColorIndex =1 AlternateBackShade =95.0 Begin Begin Label FontItalic = NotDefault OverlapFlags =85 Left =120 Top =60 Width =8775 Height =285 BorderColor =8355711 Name ="Étiquette12" Caption ="* Imprime un exemplaire de chaque formulaire depuis le début de l'année pour l'a" "gent choisi." GridlineColor =10921638 LayoutCachedLeft =120 LayoutCachedTop =60 LayoutCachedWidth =8895 LayoutCachedHeight =345 ForeTint =100.0 End End End End End CodeBehindForm Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Compare Database Private Sub AvertSQL_AfterUpdate() If Me.AvertSQL = True Then Call MAJParametre("AvertSQL", 1) Else Call MAJParametre("AvertSQL", 0) End If Me.Refresh End Sub Private Sub Commande4_Click() DoCmd.OpenForm "frm_ParamUtil" End Sub Private Sub Commande5_Click() DoCmd.OpenForm "frm_acces" End Sub Private Sub Commande6_Click() DoCmd.OpenForm "frm_SuiviVersions" End Sub Private Sub Form_Current() If parametre("AvertSQL") = 1 Then Me.AvertSQL = True Else Me.AvertSQL = False End If End Sub Private Sub ImportPDA_Click() Dim fichier As String Dim rep As String Dim nomFichier As String Dim strMAJImportRH, sql, critere As String Dim DejaImporte As Integer Dim CodeAgent As String Dim moisRH, anneeRH As Integer Dim rs As DAO.Recordset DejaImporte = 0 'chercher le nom du fichier fichier = Nz(ChercherNomFichier(), "") If fichier = "" Then Exit Sub End If '''''''procédure d'import du xml''''''' 'vider la table d'importation rapport DoCmd.SetWarnings False DoCmd.RunSQL ("DELETE * FROM Rapport;") 'test si fichier déja importé nomFichier = ExtraitNomFichier(fichier) rep = ExtraitNomRep(fichier) Call MAJParametre("RepXML", rep) DoCmd.SetWarnings False If DCount("FichierXML", "tbl_ImportRH", "[FichierXML]='" & nomFichier & "'") > 0 Or DCount("FichierXML", "tbl_ImportRH", "[FichierXML]='" & Right(nomFichier, (Len(nomFichier) - 2)) & "'") > 0 Then If MsgBox("Attention, ce fichier semble avoir déja été importé. Le réimport supprimera toutes les anciennes données relatives à ce fichier. Voulez vous continuer?", vbYesNo) = vbNo Then Exit Sub DejaImporte = 1 sql = "DELETE * FROM tbl_ImportRH WHERE [FichierXML]='" & nomFichier & "' OR [FichierXML]='" & Right(nomFichier, (Len(nomFichier) - 2)) & "';" DoCmd.RunSQL sql End If 'appeler la procédure d'import XML Call ImportXMLPDA(fichier) strShortFileName = nomFichier 'TRANSFERT DES DONNEES RH VERS tbl_ImportRH (reprendre le code SQL du module d'import PDA) strUpdateImportRH = "INSERT INTO tbl_ImportRH ( CodeLigne, CodeAgent, DateRH, CodeChantier, CodeLocalisation, Localisation, strCategorieInterventionId, HeureSup1, HeureSup2, HeureSupDimanche, Repas, DistanceTranche1, VehiculePersoTranche1, DistanceTranche2, VehiculePersoTranche2, Remarque, Depart, FichierXML, DateImport, ResponsableImport ) " & _ "SELECT Rapport.Id, Rapport.CodeAgent, ReformateDate([datedebut]) AS DDebut, Rapport.CodeChantier, Rapport.CodeLocalisation, DLookUp('strTiersMnemo','tblTiers','lngTiersId = ' & [CodeLocalisation]& ' ') AS Localisation, " & _ "Rapport.CodeNatureRealisation, Rapport.HeureSup1, Rapport.HeureSup2, Rapport.HeureSupDimanche, Rapport.Repas, Rapport.DistanceTranche1, Rapport.VehiculePersoTranche1, Rapport.DistanceTranche2, Rapport.VehiculePersoTranche2, Rapport.Remarque, Rapport.Depart, '" & strShortFileName & "' AS FichierXML, Now() AS DateImport, Environ('Username') AS ResponsableImport " & _ "FROM Rapport " & _ "WHERE (((Rapport.HeureSup1) Is Not Null) AND ((Rapport.HeureSup2) Is Not Null) AND ((Rapport.HeureSupDimanche) Is Not Null) AND ((Rapport.Repas) Is Not Null) AND ((Rapport.DistanceTranche1) Is Not Null) AND ((Rapport.VehiculePersoTranche1) Is Not Null) AND ((Rapport.DistanceTranche2) Is Not Null) AND ((Rapport.VehiculePersoTranche2) Is Not Null));" DoCmd.RunSQL strUpdateImportRH Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_ImportRH WHERE [FichierXML]='" & nomFichier & "';") If rs.RecordCount = 0 Then MsgBox "Données importées dans tbl_ImportRH; Erreur dans le retraitement des données, veuillez procéder manuellement." Exit Sub End If rs.MoveFirst CodeAgent = rs![CodeAgent] moisRH = Month(rs![DateRH]) anneeRH = Year(rs![DateRH]) If CodeAgent = "" Or Not anneeRH > 2000 Or Not moisRH <= 12 Or Not moisRH > 0 Then MsgBox "Données importées dans tbl_ImportRH; Erreur dans le retraitement des données, veuillez procéder manuellement." Exit Sub End If critere = "[CodeAgent]='" & CodeAgent & "' AND [MoisRH]=" & moisRH & " AND [AnneeRH]=" & anneeRH 'on supprime la ligne correspondante de la table tbl_suivi, puis on lance le form "frm_chargement" sql = "DELETE * FROM tbl_SuiviRH WHERE " & critere & ";" DoCmd.RunSQL sql DoCmd.SetWarnings True Call Chargement End Sub Private Sub PeripleToutExporter_Click() Dim moisRH, anneeRH, essai As Integer Dim sql As String Dim rs As DAO.Recordset If Not CurrentProject.AllForms("frm_menu").IsLoaded Then MsgBox "Le formulaire menu doit être ouvert" GoTo fin End If moisRH = forms![frm_menu].moisRH anneeRH = forms![frm_menu].anneeRH If MsgBox("Vous aller exporter vers le serveur Sharepoint les données de tous les agents pour la période suivante:" & _ vbNewLine & moisRH & "\" & anneeRH, vbOKCancel) = vbCancel Then MsgBox "Opération annulée" GoTo fin End If DoCmd.Hourglass True 'test connexion sharepoint: essai = 0 While testConnexionLecteur(lecteurVirtuel, repHttp) = False Call Attendre(500) essai = essai + 1 If essai >= 3 Then MsgBox "Erreur: impossible de se connecter au serveur sharepoint, les fichiers seront créés ici: " & vbNewLine & _ rep & nomFichier End If Wend sql = "SELECT tbl_Agents.CodeAgent, tbl_Agents.Nom " & _ "From tbl_Agents " & _ "GROUP BY tbl_Agents.CodeAgent, tbl_Agents.Nom, tbl_Agents.[CodeAgent] " & _ "HAVING (((tbl_Agents.[CodeAgent]) In (SELECT [CodeAgent] FROM tbl_ImportRH WHERE Month([DateRH])=" & moisRH & " AND Year([DateRH])=" & anneeRH & ";))) " & _ "ORDER BY tbl_Agents.Nom;" 'Debug.Print sql Set rs = CurrentDb.OpenRecordset(sql) Me.txt_prog.Visible = True If Not rs.RecordCount > 0 Then MsgBox "Erreur: aucune donnée à exporter pour cette période" GoTo fin End If rs.MoveLast rs.MoveFirst Do Until rs.EOF = True Me.txt_prog.Caption = rs.AbsolutePosition & "/" & rs.RecordCount If VerifDonneesExport(rs![CodeAgent], moisRH, anneeRH) = True Then Call Periple_MajTableTampon(rs![CodeAgent], moisRH, anneeRH, True) 'Call Periple_ExportXML(True) Else MsgBox rs![Nom] & " - Vous devez corriger les erreurs détectées dans les données pour pouvoir les exporter." End If rs.MoveNext Loop fin: On Error GoTo 0 DoCmd.Hourglass False Me.txt_prog.Visible = False Set rs = Nothing Exit Sub err: MsgBox "Erreur: " & err.Description GoTo fin End Sub Private Sub ToutImpr_Click() Dim CodeAgent, msg, critere, imprimante As String Dim rs As DAO.Recordset CodeAgent = Nz(InputBox("Code de l'agent?"), "") If Not Len(CodeAgent) > 0 Then Exit Sub If IsNull(DLookup("CodeAgent", "tbl_Agents", "[CodeAgent]='" & CodeAgent & "'")) Then MsgBox ("Code non trouvé dans tbl_Agents") Exit Sub End If Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_SuiviRH WHERE [AnneeRH]=" & Year(Now()) & " AND [CodeAgent]='" & CodeAgent & "' ORDER BY [moisRH];") If Not rs.RecordCount > 0 Then MsgBox ("Pas de données trouvées pour l'année en cours") Exit Sub End If rs.MoveFirst Do Until rs.EOF = True msg = msg & "," & MonthName(rs![moisRH]) rs.MoveNext Loop msg = "Vous allez imprimer les formulaires des mois suivants: " & vbNewLine & Right(msg, Len(msg) - 1) If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub 'selection de l'imprimante utilisateur (cf. tbl_ParamUtil) imprimante = Nz(DLookup("valeur", "tbl_ParamUtil", "[parametre]='imprimante' AND [user]='" & CurrentUser & "'"), "") If imprimante = "" Then MsgBox "Pas d'imprimante définie pour cet utilisateur (cf. tbl_parametre)" Exit Sub End If NumIMP = 0 NombreImp = Application.Printers.Count For Each ImpCherche In Application.Printers If ImpCherche.DeviceName = imprimante Then Set Application.Printer = Application.Printers(NumIMP) Exit For Else NumIMP = NumIMP + 1 End If Next ImpCherche rs.MoveFirst Do Until rs.EOF = True critere = "[CodeAgent]='" & CodeAgent & "' AND [MoisRH]=" & rs![moisRH] & " AND [AnneeRH]=" & rs![anneeRH] Call ImprEtats("Et_FormDep", 1, critere) Call ImprEtats("Et_FormHS", 1, critere) Call ImprEtats("Et_RecapEFD", 1, critere) Call ImprEtats("Et_EtFraisDep", 1, critere) rs.MoveNext Loop Set Application.Printer = Nothing End Sub