Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "BOUTONS MACROS" Then ws.Select
Application.ActivePrinter =3D "CutePDF Writer sur CPW2:"
ActiveWindow.SelectedSheets.PrintOut Copies:=3D1,
ActivePrinter:=3D"CutePDF Writer sur CPW2:", Collate:=3DTrue
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
isabelle
bonjour mboileau,
je ne connais pas cutepdf, mais si tu as installé PDFCreator voici un exemple trouver ici : http://www.excel-downloads.com/forum/112586-edition-pdf.html
Sub printtest_1() 'La feuille active. a = ActiveSheet.Name Call printsheetinpdf(Sheets(a)) End Sub
Sub printtest_2() 'Quelques feuilles du classeur, à adapter. a = ActiveSheet.Name b = "Annexe" c = Sheets(3) Call printsheetinpdf(Sheets(Array(a, b, c))) End Sub
Sub printtest_3() 'Le classeur entier. Call printsheetinpdf(ActiveWorkbook) End Sub
Sub printsheetinpdf(shsheet As Object) Dim pdfjob As Object Dim spdfname As String Dim spdfpath As String spdfname = "Fiche navette_" & Range("h8") & "_" & Format(Date, "dd-mm-yyyy") & ".pdf" 'Nom du fichier, à adapter spdfpath = "c:zz" 'Documents and Settings" & UCase(Environ("username")) & "Mes documents" 'Nom du chemin, à adapter 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") = spdfpath .cOption("AutosaveFilename") = spdfname .cOption("AutosaveFormat") = 0 .cClearCache End With shsheet.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:3")) .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
isabelle
mboileau a écrit :
Voici ma macro:
Sub PDF_print()
Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "BOUTONS MACROS" Then ws.Select Application.ActivePrinter = "CutePDF Writer sur CPW2:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="CutePDF Writer sur CPW2:", Collate:=True
Mais ça ne fonctionne pas. Le sendkeys fonctionne pour le premier onglet mais pas pour les autres.
Votre aide?
Merci
bonjour mboileau,
je ne connais pas cutepdf, mais si tu as installé PDFCreator voici un
exemple
trouver ici : http://www.excel-downloads.com/forum/112586-edition-pdf.html
Sub printtest_1()
'La feuille active.
a = ActiveSheet.Name
Call printsheetinpdf(Sheets(a))
End Sub
Sub printtest_2()
'Quelques feuilles du classeur, à adapter.
a = ActiveSheet.Name
b = "Annexe"
c = Sheets(3)
Call printsheetinpdf(Sheets(Array(a, b, c)))
End Sub
Sub printtest_3()
'Le classeur entier.
Call printsheetinpdf(ActiveWorkbook)
End Sub
Sub printsheetinpdf(shsheet As Object)
Dim pdfjob As Object
Dim spdfname As String
Dim spdfpath As String
spdfname = "Fiche navette_" & Range("h8") & "_" & Format(Date,
"dd-mm-yyyy") & ".pdf" 'Nom du fichier, à adapter
spdfpath = "c:zz" 'Documents and Settings" &
UCase(Environ("username")) & "Mes documents" 'Nom du chemin, à adapter
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") = spdfpath
.cOption("AutosaveFilename") = spdfname
.cOption("AutosaveFormat") = 0
.cClearCache
End With
shsheet.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:3"))
.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
isabelle
mboileau a écrit :
Voici ma macro:
Sub PDF_print()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "BOUTONS MACROS" Then ws.Select
Application.ActivePrinter = "CutePDF Writer sur CPW2:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1,
ActivePrinter:="CutePDF Writer sur CPW2:", Collate:=True
je ne connais pas cutepdf, mais si tu as installé PDFCreator voici un exemple trouver ici : http://www.excel-downloads.com/forum/112586-edition-pdf.html
Sub printtest_1() 'La feuille active. a = ActiveSheet.Name Call printsheetinpdf(Sheets(a)) End Sub
Sub printtest_2() 'Quelques feuilles du classeur, à adapter. a = ActiveSheet.Name b = "Annexe" c = Sheets(3) Call printsheetinpdf(Sheets(Array(a, b, c))) End Sub
Sub printtest_3() 'Le classeur entier. Call printsheetinpdf(ActiveWorkbook) End Sub
Sub printsheetinpdf(shsheet As Object) Dim pdfjob As Object Dim spdfname As String Dim spdfpath As String spdfname = "Fiche navette_" & Range("h8") & "_" & Format(Date, "dd-mm-yyyy") & ".pdf" 'Nom du fichier, à adapter spdfpath = "c:zz" 'Documents and Settings" & UCase(Environ("username")) & "Mes documents" 'Nom du chemin, à adapter 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") = spdfpath .cOption("AutosaveFilename") = spdfname .cOption("AutosaveFormat") = 0 .cClearCache End With shsheet.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:3")) .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
isabelle
mboileau a écrit :
Voici ma macro:
Sub PDF_print()
Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "BOUTONS MACROS" Then ws.Select Application.ActivePrinter = "CutePDF Writer sur CPW2:" ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="CutePDF Writer sur CPW2:", Collate:=True