Sujet Précédent Sujet Suivant

Impression pdf, msg, tiff, etc depuis Excel

Résolu
mastere30 Messages postés 35 Date d'inscription mercredi 16 juillet 2003 Statut Membre Dernière intervention 29 janvier 2016 - 28 janv. 2016 à 16:37
vb95 Messages postés 3472 Date d'inscription samedi 11 janvier 2014 Statut Contributeur Dernière intervention 13 avril 2024 - 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

1 réponse

Réponse 1 / 1
vb95 Messages postés 3472 Date d'inscription samedi 11 janvier 2014 Statut Contributeur Dernière intervention 13 avril 2024 169
28 janv. 2016 à 22:37
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
1
mastere30 Messages postés 35 Date d'inscription mercredi 16 juillet 2003 Statut Membre Dernière intervention 29 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 ;)
0
vb95 Messages postés 3472 Date d'inscription samedi 11 janvier 2014 Statut Contributeur Dernière intervention 13 avril 2024 169 > mastere30 Messages postés 35 Date d'inscription mercredi 16 juillet 2003 Statut Membre Dernière intervention 29 janvier 2016
29 janv. 2016 à 15:21
salut mastere30
bien content d'avoir fait un heureux !
Meilleurs vœux à vous
0

Discussions similaires

Conversion d'une image tiff -> jpeg sans perte
cs_dormilon -
dormilon -

4 réponses
initialisation du BITMAPINFO pour avoir une palette 256 couleurs!
SyN42 -
chris91 -

2 réponses
EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Palette couleur
max77max -
max77max -

2 réponses
Rejoignez-nous