macro print cutepdf

Le
mboileau
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

Filename = ActiveSheet.Range("A1").Value & ".pdf"
SendKeys Filename & "{ENTER}", False

Next ws

End Sub



Mais ça ne fonctionne pas. Le sendkeys fonctionne pour le premier
onglet mais pas pour les autres.

Votre aide?

Merci
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
isabelle
Le #20576901
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

Filename = ActiveSheet.Range("A1").Value & ".pdf"
SendKeys Filename & "{ENTER}", False

Next ws

End Sub

---------

Mais ça ne fonctionne pas. Le sendkeys fonctionne pour le premier
onglet mais pas pour les autres.

Votre aide?

Merci



Publicité
Poster une réponse
Anonyme