mastere30
Messages postés35Date d'inscriptionmercredi 16 juillet 2003StatutMembreDernière intervention29 janvier 2016
-
28 janv. 2016 à 16:37
vb95
Messages postés3416Date d'inscriptionsamedi 11 janvier 2014StatutContributeurDernière intervention31 mai 2023
-
29 janv. 2016 à 15:21
Bonjour,
une de mes collègues et son team doivent régulièrement imprimer des dossiers complets composés de fichiers pdf, msg, tiff, doc, docx etc.
Etant donné le nombre de documents par dossier et surtout de différents documents dont le dossier est composé, elle a regardé avec le support informatique afin qu'ils lui fournissent une solution permettant d'envoyer le contenu complet du dossier (indépendament du type de fichiers) à l'imprimante. Seule condition pour l'imprimante, imprimer dans l'ordre chronologique des documents (par date d'enregistrement).
Le support n'a pas trouvé de solution et j'ai voulu moi lui fournir une solution. Je suis parti d'une base d'un fichier excel et macro VBA.
Dès l'ouverture du fichier la première macro se lance et répertorie dans une feuille les fichiers du dossier ou est stocké mon fichier excel. Puis par un bouton je permet à l'utilisateur d'imprimer tous les documents répertoriés dans la feuille.
La macro fonctionne parfaitement, tant qu'il n'y a pas trop de documents (5 ou 6) voir plus si ce ne sont pas des pdf.
Mon problème est que les utilisateurs n'ont que Acrobat Reader XI et que bien souvent l'impression par Acrobat est trop lente par rapport à ma macro et que de ce fait des pdf arrivent plus tard dans la file d'impression que ce que je n'ai commandé par ma macro.
J'ai donc mis des pauses après l'ordre d'impression pdf, mais même avec 8 secondes de pauses le problème survient toujours.
Je cherche une solution pour que ma macro soit informée que Acrobat Reader à lancé l'impression et que tant que cette informaiton n'est pas arrivée ma macro se met en attente.
Avez-vous une idée?
Voici les procédures que j'ai mises en place actuellement
Sub imprimerFichiers() Dim derligne As Integer, i As Integer, counter As Integer Dim nomFichier As String derligne = Worksheets(1).Cells(5000, 1).End(xlUp).Row 'A rechercher avec précision On Error GoTo erreur For i = 2 To derligne nomFichier = Cells(i, 1).Value If InStr(Len(nomFichier) - 5, nomFichier, ".xl", _ vbTextCompare) > 0 Then ImprimerFichierExcel (sCheminFichiers & nomFichier) ElseIf InStr(Len(nomFichier) - 5, nomFichier, ".jpg", _ vbTextCompare) > 0 Then ImprimerFichierJPG (sCheminFichiers & nomFichier) ElseIf InStr(Len(nomFichier) - 5, nomFichier, ".tif", _ vbTextCompare) > 0 Then ImprimerFichierTiff (sCheminFichiers & nomFichier) Else ImprimerFichierPdf (sCheminFichiers & nomFichier) faisDodo (3) End If counter = counter + 1 Call compteur(counter) 'Compteur progression faisDodo (3) Next Exit Sub erreur: MsgBox "L'application à planté en essayant d'imprimer le fichier : " & nomFichier End Sub
Sub ImprimerFichierPdf(nomFichier As String) hWnd = FindWindow(vbNullString, Application.Caption) ShellExecute 0, "Print", nomFichier, _ vbNullString, vbNullString, vbHide End Sub
Sub ImprimerFichierExcel(nomFichier As String) Workbooks.Open nomFichier ActiveWorkbook.PrintOut ActiveWorkbook.Close End Sub
Sub ImprimerFichierJPG(nomFichier As String) Dim IE As internetExplorer Set IE = CreateObject("internetExplorer.Application") IE.Visible = False IE.navigate nomFichier Do Until IE.readyState = READYSTATE_COMPLETE DoEvents Loop IE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER End Sub
Sub ImprimerFichierTiff(nomFichier As String) Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Pictures.Insert(nomFichier).Select 'MsgBox ActiveSheet.Name Worksheets(ActiveSheet.Name).Select Cells(1, 1).Select With ActiveSheet.PageSetup .LeftMargin = Application.InchesToPoints(0) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) End With ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False Worksheets(1).Select End Sub
Sub faisDodo(Secondes As Integer) ' Cette procédure temporise pendant le nombre de secondes qu'on lui transmet en argument Dim Début As Long, Fin As Long, Chrono As Long Début = Timer Fin = Début + Secondes Do Until Timer >= Fin DoEvents Loop End Sub
mastere30
Messages postés35Date d'inscriptionmercredi 16 juillet 2003StatutMembreDernière intervention29 janvier 2016 29 janv. 2016 à 11:08
Merci vb95, tu n'es peut-être pas un spécialiste VBA mais un spécialiste de m'avoir trouvé la réponse. La résolution que tu m'a indiqué fonctionne à merveille et correspond à 100% à ce que je cherchais ;)
vb95
Messages postés3416Date d'inscriptionsamedi 11 janvier 2014StatutContributeurDernière intervention31 mai 2023165
>
mastere30
Messages postés35Date d'inscriptionmercredi 16 juillet 2003StatutMembreDernière intervention29 janvier 2016 29 janv. 2016 à 15:21
salut mastere30
bien content d'avoir fait un heureux !
Meilleurs vœux à vous
29 janv. 2016 à 11:08
29 janv. 2016 à 15:21
bien content d'avoir fait un heureux !
Meilleurs vœux à vous