Impression pdf, msg, tiff, etc depuis Excel [Résolu]

mastere30 35 Messages postés mercredi 16 juillet 2003Date d'inscription 29 janvier 2016 Dernière intervention - 28 janv. 2016 à 16:37 - Dernière réponse : vb95 1634 Messages postés samedi 11 janvier 2014Date d'inscriptionContributeurStatut 21 août 2018 Dernière intervention
- 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


Merci d'avance pour votre aide
Afficher la suite 

Votre réponse

3 réponses

Meilleure réponse
vb95 1634 Messages postés samedi 11 janvier 2014Date d'inscriptionContributeurStatut 21 août 2018 Dernière intervention - 28 janv. 2016 à 22:37
1
Merci
bonjour
Je ne suis pas spécialiste en VBA mais voici une piste : http://www.excel-downloads.com/forum/202987-resolu-attendre-la-fin-du-shellexecute.html

Merci vb95 1

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 69 internautes ce mois-ci

mastere30 35 Messages postés mercredi 16 juillet 2003Date d'inscription 29 janvier 2016 Dernière intervention - 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 1634 Messages postés samedi 11 janvier 2014Date d'inscriptionContributeurStatut 21 août 2018 Dernière intervention > mastere30 35 Messages postés mercredi 16 juillet 2003Date d'inscription 29 janvier 2016 Dernière intervention - 29 janv. 2016 à 15:21
salut mastere30
bien content d'avoir fait un heureux !
Meilleurs vœux à vous
Commenter la réponse de vb95

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.