Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr &
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut.. cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr &
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut.. cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$ba4acef3@reader.news.orange.fr...
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr &
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut.. cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr &
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut.. cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr &
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut.. cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$ba4acef3@reader.news.orange.fr...
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr &
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut.. cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Voilà un fichier exemple : http://cjoint.com/?0mkttCqMgAC
Selon tes besoins, tu auras peut-être quelques ajustements à faire,
mais tu as un bon début !
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d0260be$0$26881$
Bonjour MichDenis, et merci pour ta proposition! Ca n'a pas été une
promenade de santé apparemment...
Alors moi, je fais toujours avec mes petites connaissances en essayant au
mieux de lire et de comprendre. Dans un premier temps, j'ai collé le code
dans le VBA de la feuille... Il me signalait "OBJET REQUIS". Je décide
donc
de bien relire les explications. J'ouvre donc PDF Creator préalablement,
puis je sélectionne toutes les feuilles (clic droit dans les onglets des
feuilles - sélectionner toutes les feuilles). RIen de différent.
J'ai essayé d'incorporer "Worksheets.Select" au début de la macro test...
mais ça n'a rien donné. Peut-être que "Worksheets.Select" remplace un
autre
bout de code?
J'ai essayé également de le coller dans un module. Là, il y a l'air de se
passer quelque chose, mais ça bug sur :
LAPDF.Caption = "1) Initialisation de PDFCreator..."
C'est certainement du gros bidouillage mais je ne trouve pas...
Pourriez-vous m'aider?
Merci encore
Greg
"michdenis" a écrit dans le message de groupe de
discussion : idt41c$9og$Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu
lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr
&
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut..
cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend
sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur
de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Voilà un fichier exemple : http://cjoint.com/?0mkttCqMgAC
Selon tes besoins, tu auras peut-être quelques ajustements à faire,
mais tu as un bon début !
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d0260be$0$26881$426a74cc@news.free.fr...
Bonjour MichDenis, et merci pour ta proposition! Ca n'a pas été une
promenade de santé apparemment...
Alors moi, je fais toujours avec mes petites connaissances en essayant au
mieux de lire et de comprendre. Dans un premier temps, j'ai collé le code
dans le VBA de la feuille... Il me signalait "OBJET REQUIS". Je décide
donc
de bien relire les explications. J'ouvre donc PDF Creator préalablement,
puis je sélectionne toutes les feuilles (clic droit dans les onglets des
feuilles - sélectionner toutes les feuilles). RIen de différent.
J'ai essayé d'incorporer "Worksheets.Select" au début de la macro test...
mais ça n'a rien donné. Peut-être que "Worksheets.Select" remplace un
autre
bout de code?
J'ai essayé également de le coller dans un module. Là, il y a l'air de se
passer quelque chose, mais ça bug sur :
LAPDF.Caption = "1) Initialisation de PDFCreator..."
C'est certainement du gros bidouillage mais je ne trouve pas...
Pourriez-vous m'aider?
Merci encore
Greg
"michdenis" <michdenis@hotmail.com> a écrit dans le message de groupe de
discussion : idt41c$9og$1@speranza.aioe.org...
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu
lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr
&
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut..
cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend
sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$ba4acef3@reader.news.orange.fr...
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur
de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Voilà un fichier exemple : http://cjoint.com/?0mkttCqMgAC
Selon tes besoins, tu auras peut-être quelques ajustements à faire,
mais tu as un bon début !
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d0260be$0$26881$
Bonjour MichDenis, et merci pour ta proposition! Ca n'a pas été une
promenade de santé apparemment...
Alors moi, je fais toujours avec mes petites connaissances en essayant au
mieux de lire et de comprendre. Dans un premier temps, j'ai collé le code
dans le VBA de la feuille... Il me signalait "OBJET REQUIS". Je décide
donc
de bien relire les explications. J'ouvre donc PDF Creator préalablement,
puis je sélectionne toutes les feuilles (clic droit dans les onglets des
feuilles - sélectionner toutes les feuilles). RIen de différent.
J'ai essayé d'incorporer "Worksheets.Select" au début de la macro test...
mais ça n'a rien donné. Peut-être que "Worksheets.Select" remplace un
autre
bout de code?
J'ai essayé également de le coller dans un module. Là, il y a l'air de se
passer quelque chose, mais ça bug sur :
LAPDF.Caption = "1) Initialisation de PDFCreator..."
C'est certainement du gros bidouillage mais je ne trouve pas...
Pourriez-vous m'aider?
Merci encore
Greg
"michdenis" a écrit dans le message de groupe de
discussion : idt41c$9og$Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu
lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr
&
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut..
cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend
sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur
de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Voilà un fichier exemple : http://cjoint.com/?0mkttCqMgAC
Selon tes besoins, tu auras peut-être quelques ajustements à faire,
mais tu as un bon début !
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d0260be$0$26881$
Bonjour MichDenis, et merci pour ta proposition! Ca n'a pas été une
promenade de santé apparemment...
Alors moi, je fais toujours avec mes petites connaissances en essayant au
mieux de lire et de comprendre. Dans un premier temps, j'ai collé le code
dans le VBA de la feuille... Il me signalait "OBJET REQUIS". Je décide
donc
de bien relire les explications. J'ouvre donc PDF Creator préalablement,
puis je sélectionne toutes les feuilles (clic droit dans les onglets des
feuilles - sélectionner toutes les feuilles). RIen de différent.
J'ai essayé d'incorporer "Worksheets.Select" au début de la macro test...
mais ça n'a rien donné. Peut-être que "Worksheets.Select" remplace un
autre
bout de code?
J'ai essayé également de le coller dans un module. Là, il y a l'air de se
passer quelque chose, mais ça bug sur :
LAPDF.Caption = "1) Initialisation de PDFCreator..."
C'est certainement du gros bidouillage mais je ne trouve pas...
Pourriez-vous m'aider?
Merci encore
Greg
"michdenis" a écrit dans le message de groupe de
discussion : idt41c$9og$Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu
lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr
&
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut..
cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend
sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur
de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Voilà un fichier exemple : http://cjoint.com/?0mkttCqMgAC
Selon tes besoins, tu auras peut-être quelques ajustements à faire,
mais tu as un bon début !
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d0260be$0$26881$426a74cc@news.free.fr...
Bonjour MichDenis, et merci pour ta proposition! Ca n'a pas été une
promenade de santé apparemment...
Alors moi, je fais toujours avec mes petites connaissances en essayant au
mieux de lire et de comprendre. Dans un premier temps, j'ai collé le code
dans le VBA de la feuille... Il me signalait "OBJET REQUIS". Je décide
donc
de bien relire les explications. J'ouvre donc PDF Creator préalablement,
puis je sélectionne toutes les feuilles (clic droit dans les onglets des
feuilles - sélectionner toutes les feuilles). RIen de différent.
J'ai essayé d'incorporer "Worksheets.Select" au début de la macro test...
mais ça n'a rien donné. Peut-être que "Worksheets.Select" remplace un
autre
bout de code?
J'ai essayé également de le coller dans un module. Là, il y a l'air de se
passer quelque chose, mais ça bug sur :
LAPDF.Caption = "1) Initialisation de PDFCreator..."
C'est certainement du gros bidouillage mais je ne trouve pas...
Pourriez-vous m'aider?
Merci encore
Greg
"michdenis" <michdenis@hotmail.com> a écrit dans le message de groupe de
discussion : idt41c$9og$1@speranza.aioe.org...
Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu
lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr
&
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut..
cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend
sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$ba4acef3@reader.news.orange.fr...
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur
de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Voilà un fichier exemple : http://cjoint.com/?0mkttCqMgAC
Selon tes besoins, tu auras peut-être quelques ajustements à faire,
mais tu as un bon début !
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d0260be$0$26881$
Bonjour MichDenis, et merci pour ta proposition! Ca n'a pas été une
promenade de santé apparemment...
Alors moi, je fais toujours avec mes petites connaissances en essayant au
mieux de lire et de comprendre. Dans un premier temps, j'ai collé le code
dans le VBA de la feuille... Il me signalait "OBJET REQUIS". Je décide
donc
de bien relire les explications. J'ouvre donc PDF Creator préalablement,
puis je sélectionne toutes les feuilles (clic droit dans les onglets des
feuilles - sélectionner toutes les feuilles). RIen de différent.
J'ai essayé d'incorporer "Worksheets.Select" au début de la macro test...
mais ça n'a rien donné. Peut-être que "Worksheets.Select" remplace un
autre
bout de code?
J'ai essayé également de le coller dans un module. Là, il y a l'air de se
passer quelque chose, mais ça bug sur :
LAPDF.Caption = "1) Initialisation de PDFCreator..."
C'est certainement du gros bidouillage mais je ne trouve pas...
Pourriez-vous m'aider?
Merci encore
Greg
"michdenis" a écrit dans le message de groupe de
discussion : idt41c$9og$Bonjour,
Voici une façon de faire en utilisant l'utilitaire PDFCreator disponible
gratuitement en téléchargement sur le Net. Ceci
devrait fonctionner quelle que soit la version d'Excel
Tu sélectionnes les feuilles du classeur que tu veux imprimer et tu
lances
la procédure Test.
Si tu veux sélectionner toutes les feuilles du classeur.
Worksheets.Select
'-----------------------------------
Sub test()
Dim Tblo(), A As Integer, Nb As Integer
With ActiveWindow.SelectedSheets
Nb = .Count
ReDim Tblo(1 To Nb)
End With
For Each sh In ActiveWindow.SelectedSheets
A = A + 1
Tblo(A) = sh.Name
Next
Call ImprPDF(Tblo)
End Sub
'-----------------------------------
Sub ImprPDF(MesFeuilles())
Dim PdfJob As Object ' déclaration de la tache qu'on va créer
Dim SpdFname As String ' le nom du fichier
Dim SpdFpath As String ' le nom du répertoire
/*** à poursuivre avec les valeurs désirées/
' termine toute tache en cours si PDFCreator est encore en exécution
LAPDF.Caption = "1) Initialisation de PDFCreator..."
Application.Cursor = xlWait
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
' obtention d'une instance pour la tâche d'impression
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
Application.Cursor = xlDefault
LAPDF.Caption = ""
With PdfJob
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox "DESOLE... impossible d'initialiser PDF Creator..." & vbCr
&
_
"Veuillez voir le problème et relancer l'opération plus tard
S.V.P..."
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0
.ccombineall
.cClearCache
End With
' arrete la tache d'impression (pour éviter la création
'automatique du premier fichier)
PdfJob.cPrinterStop = True
LAPDF.Caption = "2) Préparation des fichiers dans la file d'attente..."
Application.Cursor = xlWait
Sheets(MesFeuilles).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
' ou bien activeworkbook.printout, ou activesheet... comme vous voulez/
' attend qu'il y ait tous les documents dans la file
'd'attente cCountOfPrintJobs est le nombre de fichiers dans la file
d'attente
' La main retourne à EXCEL pendant le travail de PDF... il faut attendre
Do Until PdfJob.ccountofprintjobs = NBJ
LAPDF.Caption = PdfJob.ccountofprintjobs & "/" & NBJ & " fichiers dans
la file d'attente..."
DoEvents
Loop
' commande le regroupement en une seule tache d'impression
LAPDF.Caption = "3) Regroupement des fichiers dans la file d'attente..."
Application.Cursor = xlWait
PdfJob.ccombineall
' On attend qu'il n'y ait plus qu'un job.. même chose que plus haut..
cela
prend du temps et excel doit patienter
Do Until PdfJob.ccountofprintjobs = 1
DoEvents
Loop
Application.Cursor = xlDefault
' Plus qu'un seul fichier... on suppose que c'est bon
' libere la tache d'impression (lance la création du fichier) et attend
sa
fin
LAPDF.Caption = "4) Création du fichier PDF final..."
Application.Cursor = xlWait
PdfJob.cPrinterStop = False
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
LAPDF.Caption = ""
Application.Cursor = xlDefault
' restauration de l'état
With PdfJob
.cDefaultprinter = defaultprinter
.cClearCache
Application.Wait (Now + TimeValue("0:00:03"))
.cClose
End With
Set PdfJob = Nothing
MsgBox "Le fichier PDF a été créé:' " & SFICPDF & "..."
End Sub
'-----------------------------------
Sub killtask(sappname As String)
' /**** j'ai pris le code tel quel... pas de commentaire/
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
'------------------------------------
MichD
--------------------------------------------
"Greg" a écrit dans le message de groupe de discussion :
4d01f483$0$5411$
Bonjour,
Je souhaite, à partir d'un classeur excel contenant plusieurs feuilles,
produire des fiches au format PDF. Le classeur contient des nombres
aléatoires, et l'actualisation du classeur par la touche F9 me permet de
produire des fiches différentes entre chaque impression. Je souhaite
produire une trentaine de fiches pour chaque classeur et autant de
classeurs
à faire (soit près de 1000 fiches).
Je suis actuellement sous 2007, ce qui m'oblige à faire :
- enregistrer sous ... format PDF
- cocher la case "optimiser pour une taille minimale en vue d'une
publication sur le net"
- ouvrir les options et choisir d'imprimer tout le classeur
- nommer la fiche ("fiche_9" si c'est la neuvième)
- et enfin... Valider....
La démarche est donc très répétitive et plutôt lourde, surtout si je dois
produire 30 fiches pour chaque classeur. J'ai bien tenté l'enregistreur
de
macro, mais ça bug.
Pourriez-vous m'aider?
Merci d'avance
Greg
Je n'ai pas vraiment saisi ce que tu tentes de faire...mais je crois que
tu as
tout ce qu'il faut pour finaliser la procédure que tu désires...
Pour résoudre ta difficulté d'attribuer le nom "toto" + l'index suivant
que tu désires, J'ai ajouté un bout de code....Évidemment tu peux
remplacer "toto" pour la racine du nom que tu veux.
Option Explicit
'Selon la puissance de l'ordinateur et l'importance de la tâche
'à réaliser, on peut être appelé à modifier cette valeur
Const Délai = 2.5
'---------------------------------------------------------
Sub test()
Dim Répertoire As String
Dim Creation As Boolean
'Où tu veux avoir tes fichiers PDF , à adapter
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select 'Sélectionne toutes les feuilles du fichier
'Créer un fichier pdf pour chacune des feuilles du fichier
Call Créer_Un_Fichier_PDF(Répertoire, True)
End Sub
'---------------------------------------------------------
Sub Créer_Un_Fichier_PDF(Répertoire As String, _
Creation As Boolean)
Dim PdfJob As Object, NbJobs As Integer
Dim Default_Printer As String, Sh As Object
Dim SonNom As String
KillTask ("PDFCreator.exe") 'Procédure écrite plus bas...
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If PdfJob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'La racine du nom du fichier que tu veux
SonNom = "toto"
'Appelle la procédure pour incrémenter le nom
'LaProcédure qui un NOM portant l'appellation "NomFichier"
'dans la collection Names. Sa valeur aura comme racine
'toto" ainsi qu'un index incrémenté
'Ce nom n'est pas visible dans l'interface de la feuille
'de calcul car il est masqué. Il sera sauvegardé en même
'temps que les autres données du fichier
LeNomFichierSuivant SonNom
For Each Sh In ActiveWindow.SelectedSheets
With PdfJob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = Répertoire
.cOption("AutosaveFilename") = SonNom & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprime la feuille sélectionnée
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
'Wait until all print jobs have entered the print queue
NbJobs = PdfJob.ccountofprintjobs
If NbJobs > 0 Then
Creation = True
Do Until PdfJob.ccountofprintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With PdfJob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
End If
Next
PdfJob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
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
'---------------------------------------------------------
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function
'---------------------------------------------------------
Sub LeNomFichierSuivant(SonNom As String)
Dim x As Long, N As Name
On Error Resume Next
Set N = ThisWorkbook.Names("NomFichier")
If Err <> 0 Then Err = 0
If N Is Nothing Then
Set N = ThisWorkbook.Names.Add("NomFichier", SonNom & " " & 1, False)
SonNom = Evaluate(N.Name)
Else
x = Split(Evaluate(N.Name), " ")(1) + 1
ThisWorkbook.Names.Add "NomFichier", SonNom & " " & 1, False
SonNom = Evaluate(N.Name)
End If
End Sub
'---------------------------------------------------------------------
MichD
--------------------------------------------
Je n'ai pas vraiment saisi ce que tu tentes de faire...mais je crois que
tu as
tout ce qu'il faut pour finaliser la procédure que tu désires...
Pour résoudre ta difficulté d'attribuer le nom "toto" + l'index suivant
que tu désires, J'ai ajouté un bout de code....Évidemment tu peux
remplacer "toto" pour la racine du nom que tu veux.
Option Explicit
'Selon la puissance de l'ordinateur et l'importance de la tâche
'à réaliser, on peut être appelé à modifier cette valeur
Const Délai = 2.5
'---------------------------------------------------------
Sub test()
Dim Répertoire As String
Dim Creation As Boolean
'Où tu veux avoir tes fichiers PDF , à adapter
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select 'Sélectionne toutes les feuilles du fichier
'Créer un fichier pdf pour chacune des feuilles du fichier
Call Créer_Un_Fichier_PDF(Répertoire, True)
End Sub
'---------------------------------------------------------
Sub Créer_Un_Fichier_PDF(Répertoire As String, _
Creation As Boolean)
Dim PdfJob As Object, NbJobs As Integer
Dim Default_Printer As String, Sh As Object
Dim SonNom As String
KillTask ("PDFCreator.exe") 'Procédure écrite plus bas...
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If PdfJob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'La racine du nom du fichier que tu veux
SonNom = "toto"
'Appelle la procédure pour incrémenter le nom
'LaProcédure qui un NOM portant l'appellation "NomFichier"
'dans la collection Names. Sa valeur aura comme racine
'toto" ainsi qu'un index incrémenté
'Ce nom n'est pas visible dans l'interface de la feuille
'de calcul car il est masqué. Il sera sauvegardé en même
'temps que les autres données du fichier
LeNomFichierSuivant SonNom
For Each Sh In ActiveWindow.SelectedSheets
With PdfJob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = Répertoire
.cOption("AutosaveFilename") = SonNom & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprime la feuille sélectionnée
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
'Wait until all print jobs have entered the print queue
NbJobs = PdfJob.ccountofprintjobs
If NbJobs > 0 Then
Creation = True
Do Until PdfJob.ccountofprintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With PdfJob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
End If
Next
PdfJob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
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
'---------------------------------------------------------
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function
'---------------------------------------------------------
Sub LeNomFichierSuivant(SonNom As String)
Dim x As Long, N As Name
On Error Resume Next
Set N = ThisWorkbook.Names("NomFichier")
If Err <> 0 Then Err = 0
If N Is Nothing Then
Set N = ThisWorkbook.Names.Add("NomFichier", SonNom & " " & 1, False)
SonNom = Evaluate(N.Name)
Else
x = Split(Evaluate(N.Name), " ")(1) + 1
ThisWorkbook.Names.Add "NomFichier", SonNom & " " & 1, False
SonNom = Evaluate(N.Name)
End If
End Sub
'---------------------------------------------------------------------
MichD
--------------------------------------------
Je n'ai pas vraiment saisi ce que tu tentes de faire...mais je crois que
tu as
tout ce qu'il faut pour finaliser la procédure que tu désires...
Pour résoudre ta difficulté d'attribuer le nom "toto" + l'index suivant
que tu désires, J'ai ajouté un bout de code....Évidemment tu peux
remplacer "toto" pour la racine du nom que tu veux.
Option Explicit
'Selon la puissance de l'ordinateur et l'importance de la tâche
'à réaliser, on peut être appelé à modifier cette valeur
Const Délai = 2.5
'---------------------------------------------------------
Sub test()
Dim Répertoire As String
Dim Creation As Boolean
'Où tu veux avoir tes fichiers PDF , à adapter
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select 'Sélectionne toutes les feuilles du fichier
'Créer un fichier pdf pour chacune des feuilles du fichier
Call Créer_Un_Fichier_PDF(Répertoire, True)
End Sub
'---------------------------------------------------------
Sub Créer_Un_Fichier_PDF(Répertoire As String, _
Creation As Boolean)
Dim PdfJob As Object, NbJobs As Integer
Dim Default_Printer As String, Sh As Object
Dim SonNom As String
KillTask ("PDFCreator.exe") 'Procédure écrite plus bas...
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If PdfJob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'La racine du nom du fichier que tu veux
SonNom = "toto"
'Appelle la procédure pour incrémenter le nom
'LaProcédure qui un NOM portant l'appellation "NomFichier"
'dans la collection Names. Sa valeur aura comme racine
'toto" ainsi qu'un index incrémenté
'Ce nom n'est pas visible dans l'interface de la feuille
'de calcul car il est masqué. Il sera sauvegardé en même
'temps que les autres données du fichier
LeNomFichierSuivant SonNom
For Each Sh In ActiveWindow.SelectedSheets
With PdfJob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = Répertoire
.cOption("AutosaveFilename") = SonNom & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprime la feuille sélectionnée
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
'Wait until all print jobs have entered the print queue
NbJobs = PdfJob.ccountofprintjobs
If NbJobs > 0 Then
Creation = True
Do Until PdfJob.ccountofprintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With PdfJob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
End If
Next
PdfJob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
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
'---------------------------------------------------------
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function
'---------------------------------------------------------
Sub LeNomFichierSuivant(SonNom As String)
Dim x As Long, N As Name
On Error Resume Next
Set N = ThisWorkbook.Names("NomFichier")
If Err <> 0 Then Err = 0
If N Is Nothing Then
Set N = ThisWorkbook.Names.Add("NomFichier", SonNom & " " & 1, False)
SonNom = Evaluate(N.Name)
Else
x = Split(Evaluate(N.Name), " ")(1) + 1
ThisWorkbook.Names.Add "NomFichier", SonNom & " " & 1, False
SonNom = Evaluate(N.Name)
End If
End Sub
'---------------------------------------------------------------------
MichD
--------------------------------------------
Une procédure pour imprimer tout le fichier :
Const Délai = 2.5
Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
NomFichier = "MichD"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
Créer_Un_Fichier_PDF Répertoire, NomFichier, True
Sheets(NomFeuille).Select
End Sub
Sub Créer_Un_Fichier_PDF(SpdFpath As String, _
SpdFname As String, Creation As Boolean)
Dim pdfjob As Object, NbJobs As Integer, Sh As Object
Dim Default_Printer As String
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If pdfjob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprimer les feuilles sélectionnées
With ActiveWindow
For Each Sh In .SelectedSheets
If TypeName(Sh) = "Chart" Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Else
If Not IsEmpty(Sh.UsedRange) Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Sh.DisplayPageBreaks = False
End If
End If
Next
End With
'Wait until all print jobs have entered the print queue
NbJobs = pdfjob.cCountOfPrintjobs
If NbJobs > 0 Then
Creation = True
Do Until pdfjob.cCountOfPrintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
pdfjob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
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
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function
MichD
--------------------------------------------
Une procédure pour imprimer tout le fichier :
Const Délai = 2.5
Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
NomFichier = "MichD"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
Créer_Un_Fichier_PDF Répertoire, NomFichier, True
Sheets(NomFeuille).Select
End Sub
Sub Créer_Un_Fichier_PDF(SpdFpath As String, _
SpdFname As String, Creation As Boolean)
Dim pdfjob As Object, NbJobs As Integer, Sh As Object
Dim Default_Printer As String
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If pdfjob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprimer les feuilles sélectionnées
With ActiveWindow
For Each Sh In .SelectedSheets
If TypeName(Sh) = "Chart" Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Else
If Not IsEmpty(Sh.UsedRange) Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Sh.DisplayPageBreaks = False
End If
End If
Next
End With
'Wait until all print jobs have entered the print queue
NbJobs = pdfjob.cCountOfPrintjobs
If NbJobs > 0 Then
Creation = True
Do Until pdfjob.cCountOfPrintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
pdfjob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
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
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function
MichD
--------------------------------------------
Une procédure pour imprimer tout le fichier :
Const Délai = 2.5
Sub test()
Dim Répertoire As String
Dim NomFichier As String
Dim NomFeuille As String
NomFeuille = ActiveSheet.Name
NomFichier = "MichD"
Répertoire = "C:MonCheminMes Fichiers PDF"
Sheets.Select
Créer_Un_Fichier_PDF Répertoire, NomFichier, True
Sheets(NomFeuille).Select
End Sub
Sub Créer_Un_Fichier_PDF(SpdFpath As String, _
SpdFname As String, Creation As Boolean)
Dim pdfjob As Object, NbJobs As Integer, Sh As Object
Dim Default_Printer As String
killtask ("PDFCreator.exe") 'Procédure écrite plus bas...
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If pdfjob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname & ".pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
Application.ScreenUpdating = False
Default_Printer = Application.ActivePrinter
'Imprimer les feuilles sélectionnées
With ActiveWindow
For Each Sh In .SelectedSheets
If TypeName(Sh) = "Chart" Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Else
If Not IsEmpty(Sh.UsedRange) Then
'Sh.PageSetup.Orientation = xlLandscape
Sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Attente Délai
Sh.DisplayPageBreaks = False
End If
End If
Next
End With
'Wait until all print jobs have entered the print queue
NbJobs = pdfjob.cCountOfPrintjobs
If NbJobs > 0 Then
Creation = True
Do Until pdfjob.cCountOfPrintjobs = NbJobs
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
pdfjob.cClose
Application.ScreenUpdating = True
Application.ActivePrinter = Default_Printer
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
Function Attente(x As Double)
Dim T As Double
T = Timer + x
Do While Timer <= T
DoEvents
Loop
End Function
MichD
--------------------------------------------