problème attente fin d'impression en pdf

[teter]

Bonjour à tous,

Je cherche à envoyer en pdf et sauver automatiquement plusieurs fichiers excel d'un folder sous le même nom en pdf (abc.xls, def.xls, ;;; -> abc.pdf, def.pdf, ...). Ces fichiers ont la même structure avec une feuille "rapport" à exporter en pdf.
J'ai trouvé la macro suivante (merci je ne sais plus qui 🙂) mais le temps d'impression en pdf est assez long et ma macro n'attends pas, elle ferme mon fichier excel alors que l'impression n'est pas finie et du coup, ça plante.

J'ai essayé un timer, un application.wait ma ça ne prend pas. Je pense qu'il me faudrait une boucle effectuant la manip suivante : tant que mon fichier en cours d'impression n'est pas sauvé et fermé, ne pas continuer (ie ne pas fermé le fichier excel) mais je ne connais pas encore trop les boucles donc si qq'un peut m'aider ...

Ci joint le code.

Merci d'avance pour vos réponses et bon WE.

Teter

Sub Macro1()

Dim F As Variant
With Application.FileSearch
.NewSearch
.LookIn = "F:\test"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
PDFTPRINT
Next F
End With
End Sub

Sub PDFTPRINT()
Dim Nom As String
Dim C As Byte
Dim CC As Byte
C = Len(ActiveWorkbook.Name)
CC = C - 4
Nom = Left(ActiveWorkbook.Name, CC)
Application.SendKeys Keys:=" F:\test\" & Nom + "~"
Sheets("rapport").PrintOut ActivePrinter:="Adobe PDF sur Ne01:", Collate:=True

'Boucle manquante ???

ActiveWorkbook.Close False
End Sub

 

[PMO2]

Re : problème attente fin d'impression en pdf

Bonjour,

A tout hasard, essayez avec ce code modifié.
Après plusieurs essais, il vous faudra affiner, à votre usage, la ligne de code
Sleep 10000
où le paramètre est exprimé en millisecondes (10000 = 10 secondes)

Declare Function GetTickCount Lib "kernel32" () As Long         '--- ajout pmo ---
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '--- ajout pmo ---

Sub Macro1()
Dim F As Variant
With Application.FileSearch
.NewSearch
.LookIn = "F:\test"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
PDFTPRINT
Next F
End With
End Sub

Sub PDFTPRINT()
Dim Nom As String
Dim C As Byte
Dim CC As Byte
C = Len(ActiveWorkbook.Name)
CC = C - 4
Nom = Left(ActiveWorkbook.Name, CC)
Application.SendKeys Keys:=" F:\test\" & Nom + "~"   'à quoi cela sert ???
Sheets("rapport").PrintOut ActivePrinter:="Adobe PDF sur Ne01:", Collate:=True

     '--- ajout pmo ---
Dim t&
t& = GetTickCount
Sleep 10000    'à adapter
MsgBox "Temporisation en millisecondes =" & GetTickCount - t&
     '----------------

ActiveWorkbook.Close False
End Sub

En espérant que cela apporte une solution à votre problème.

Cordialement.

PMO
Patrick Morange

 

[teter]

Re : problème attente fin d'impression en pdf

Bonjour,

Merci Patrick pour votre réponse et votre question.
Je me suis aperçu que l'instruction SenKeys est inutile ici car le nom du fichier pfd est systématiquement celui du xls.
J'ai apporté quelques modifs à la macro : au niveau temps, tout va bien, mais je reste confronté à la nécessité de cliquer "Save" à chaque fois qu'un xls est envoyé en pdf.
Quelqu'un sait-il comment "zapper" cette manipulation (j'ai essayé un SendKeys avec 2 fois TAB et ENTER sans succès ?

Merci

Cordialement

Teter

Declare Function GetTickCount Lib "kernel32" () As Long '--- ajout pmo ---
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '--- ajout pmo ---
Sub print_several_files_to_pdf()
Dim F As Variant
Dim Nom As String
With Application.FileSearch
.NewSearch
.LookIn = "F:\test"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F, UpdateLinks:=0
'timer 5 sec
Dim t&
t& = GetTickCount
Sleep 5000 '5000 milisecondes
Sheets("rapport").PrintOut ActivePrinter:="Adobe PDF sur Ne01:", Collate:=True
'timer 5 sec
Dim t2&
t2& = GetTickCount
Sleep 5000 '5000 milisecondes

ActiveWorkbook.Close False
Next F
End With
End Sub