Impression de plusieurs fichiers en pdf avec la macro VBA

Le
esmail
Bonjour,

Je souhaite automatiser une tache d'impression, je m'explique:
Les fichiers se trouvent dans le meme dossier avec les noms differents, le
but est de les imprimer en pdf ( avec pdfcreator ). Jusque la , j'arrive à
lire les noms des fichies, les stocker dans un tableau, les ouvrir, mais
apres lancement d'impression c'est le fichier excel qui contient la macro
qui est imprimé et non pas le fichier qui doit etre imprimé.
Meme en activant le fichier à imprimer, c'est toujours le fichier qui
contient la macro qui est imprimé.

merci pour vos lumieres
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #21234131
Bonjour,

Je n'ai pas PdfCreator d'installer sur mon ordinateur.
Résultat : ce que je propose n'a pas été testé.

Les procédures : "PrintWorkbookInPdf" et "killtask"
furent publiés sur ce forum.

Dans la procédure PrintTest, tu as quelques variables
à définir.

Place tout ce qui suit dans un module standard.
'---------------------------------------------------
Sub printtest()
Dim Wk As Workbook

Dim Repertoire As String
Dim Sauvegarde As String
Dim Fichier As String

'où sont les fichiers
Repertoire = "C:UsersDMDocuments"
'Où tu veux enregistrer les fichiers pdf
Sauvegarde = "C:UsersDMDocumentsPdf"

If Dir(Sauvegarde, vbDirectory) = "" Then
'Évidemment on pourrait ajouter du code pour le créer !
MsgBox "Le répertoire de sauvegarde est inexistant"
Exit Sub
End If

Fichier = Dir(Repertoire & "*.xl*")

Do While Fichier <> ""
Set Wk = Workbooks.Open(Repertoire & Fichier)
PrintWorkbookInPdf Wk, Sauvegarde
Wk.Close False
Fichier = Dir()
Loop
End Sub
'---------------------------------------------------

Sub PrintWorkbookInPdf(Wk As Workbook, Sauvegarde As String)
Dim pdfjob As Object
Call killtask("PDFCreator.exe")
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", _
vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = Sauvegarde
.cOption("AutosaveFilename") = Wk.Name & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Wk.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set pdfjob = Nothing
End Sub
'---------------------------------------------------
Sub killtask(sappname As String)
Dim oProclist As Object
Dim oWMI As Object
Dim oProc As Object
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
Set oProclist = oWMI.InstancesOf("win32_process")
For Each oProc In oProclist
If UCase(oProc.Name) = UCase(sappname) Then
oProc.Terminate (0)
End If
Next oProc
Else
MsgBox "Killing """ & sappname & _
""" - Can't create WMI Object.", _
vbOKOnly + vbCritical, "CloseAPP_B"
End If
Set oProclist = Nothing
Set oWMI = Nothing
End Sub
'---------------------------------------------------





"esmail" 4b7f1336$0$20662$
Bonjour,

Je souhaite automatiser une tache d'impression, je m'explique:
Les fichiers se trouvent dans le meme dossier avec les noms differents, le
but est de les imprimer en pdf ( avec pdfcreator ). Jusque la , j'arrive à
lire les noms des fichies, les stocker dans un tableau, les ouvrir, mais
apres lancement d'impression c'est le fichier excel qui contient la macro
qui est imprimé et non pas le fichier qui doit etre imprimé.
Meme en activant le fichier à imprimer, c'est toujours le fichier qui
contient la macro qui est imprimé.

merci pour vos lumieres
esmail
Le #21238271
Bonsoir,

Merci pour votre aide, ca marche.


"michdenis"
Bonjour,

Je n'ai pas PdfCreator d'installer sur mon ordinateur.
Résultat : ce que je propose n'a pas été testé.

Les procédures : "PrintWorkbookInPdf" et "killtask"
furent publiés sur ce forum.

Dans la procédure PrintTest, tu as quelques variables
à définir.

Place tout ce qui suit dans un module standard.
'---------------------------------------------------
Sub printtest()
Dim Wk As Workbook

Dim Repertoire As String
Dim Sauvegarde As String
Dim Fichier As String

'où sont les fichiers
Repertoire = "C:UsersDMDocuments"
'Où tu veux enregistrer les fichiers pdf
Sauvegarde = "C:UsersDMDocumentsPdf"

If Dir(Sauvegarde, vbDirectory) = "" Then
'Évidemment on pourrait ajouter du code pour le créer !
MsgBox "Le répertoire de sauvegarde est inexistant"
Exit Sub
End If

Fichier = Dir(Repertoire & "*.xl*")

Do While Fichier <> ""
Set Wk = Workbooks.Open(Repertoire & Fichier)
PrintWorkbookInPdf Wk, Sauvegarde
Wk.Close False
Fichier = Dir()
Loop
End Sub
'---------------------------------------------------

Sub PrintWorkbookInPdf(Wk As Workbook, Sauvegarde As String)
Dim pdfjob As Object
Call killtask("PDFCreator.exe")
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", _
vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = Sauvegarde
.cOption("AutosaveFilename") = Wk.Name & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Wk.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set pdfjob = Nothing
End Sub
'---------------------------------------------------
Sub killtask(sappname As String)
Dim oProclist As Object
Dim oWMI As Object
Dim oProc As Object
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
Set oProclist = oWMI.InstancesOf("win32_process")
For Each oProc In oProclist
If UCase(oProc.Name) = UCase(sappname) Then
oProc.Terminate (0)
End If
Next oProc
Else
MsgBox "Killing """ & sappname & _
""" - Can't create WMI Object.", _
vbOKOnly + vbCritical, "CloseAPP_B"
End If
Set oProclist = Nothing
Set oWMI = Nothing
End Sub
'---------------------------------------------------





"esmail" 4b7f1336$0$20662$
Bonjour,

Je souhaite automatiser une tache d'impression, je m'explique:
Les fichiers se trouvent dans le meme dossier avec les noms differents, le
but est de les imprimer en pdf ( avec pdfcreator ). Jusque la , j'arrive à
lire les noms des fichies, les stocker dans un tableau, les ouvrir, mais
apres lancement d'impression c'est le fichier excel qui contient la macro
qui est imprimé et non pas le fichier qui doit etre imprimé.
Meme en activant le fichier à imprimer, c'est toujours le fichier qui
contient la macro qui est imprimé.

merci pour vos lumieres



Publicité
Poster une réponse
Anonyme