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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
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