macro excel impression PDF

[casamartin]

Bonjour à tous,
J'ai pompé une macro sur le forum pour imprimer en PDF.
Elle fonctionne mais j'ai des modifications à y faire.
Cette macro imprime l'ensemble des feuilles du classeur, je veux imprimer que la feuille ou se trouve le bouton de commande macro.
De plus cette macro intègre le chemin dans le nom du fichier, je veux que le nom du fichier.
Merci d'avance pour vos lumières.

Sub ToPdf()

Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
Dim nomPdf As String
Range("M1").Select
nomPdf = ThisWorkbook.Path & "\" & ActiveCell.Text & ".pdf"
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") = ThisWorkbook.Path
.cOption("AutosaveFilename") = nomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ThisWorkbook.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
.cClose
End With
Set pdfjob = Nothing
End Sub

 

[kiki29]

Re : macro excel impression PDF

re,regarde la présentation des codes fournis dans mes posts ci-dessus
ainsi que Code.jpg

 

[casamartin]

Re : macro excel impression PDF

J'ai installé les modifications et il écrase directement le fichier sans poser de question oui ou non.

 

[kiki29]

Re : macro excel impression PDF

re,je ne suis pas derrière ton écran donc essaie et tu verras

 

[casamartin]

Re : macro excel impression PDF

je suis comme le bourgeois gentillaume, j'ai balisé sans le savoir.

 

[casamartin]

Re : macro excel impression PDF

j'ai fait certainement une erreur, voici l'intégration du code.

Next
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox " PDFCreator n'a pu être démarrer.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
End With
NomPdf = ActiveSheet.Range("M1") & " " & ActiveSheet.Name & ".pdf"
fichname = ThisWorkbook.Path & "\" & NomPdf
If ExistenceFichier(NomPdf) Then
Rep = MsgBox("Le fichier existe déjà" & vbCrLf & "L'écraser : ", vbYesNo)
End If

If Rep = 7 Then Exit Sub

With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = (ThisWorkbook.Path)
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
DefaultPrinter = .cDefaultprinter
End With

 

[kiki29]

Re : macro excel impression PDF

oops pas de F5

 

[kiki29]

Re : macro excel impression PDF

re,visiblment tu n'as pas compris pour le balisage,sinon

If ExistenceFichier(fichname) Then

 

[casamartin]

Re : macro excel impression PDF

ça marche du feu de dieu, pour te récompenser je t'envoie un peu de soleil des tropiques, encore merci.

 

[casamartin]

Re : macro excel impression PDF

Rebonjour,
J'ai découvert aprés quelques manipulations un nouveau petit problème.
La macro pour PDF fonctionne mais lorsque je fait une impression directe sur l'imprimante par défaut elle passe sur le spool PDFcreatore
Que dois je modifier pour le retour sur l'imprimante par défaut.

Ci-joint les deux macros.

Function ExistenceFichier(sFichier As String) As Boolean
ExistenceFichier = Dir(sFichier) <> ""
End Function
Sub ImprPdf()
Dim Rep As Long
Dim pdfjob As Object
Dim myprint As String
Dim Port As Integer
Dim fichname As String
Dim NomPdf As String
Dim DefaultPrinter As String
For Port = 0 To 9
myprint = "PDFCreator sur Ne0" & Port & ":"
On Error Resume Next
ActivePrinter = myprint
If ActivePrinter = myprint Then
Exit For
End If
Next
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox " PDFCreator n'a pu être démarrer.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
End With
NomPdf = ActiveSheet.Range("M1") & ".pdf"
fichname = ThisWorkbook.Path & "\" & NomPdf
If ExistenceFichier(fichname) Then
Rep = MsgBox("Le fichier existe déjà" & vbCrLf & "L'écraser ?", vbYesNo)
End If

If Rep = 7 Then Exit Sub

With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = (ThisWorkbook.Path)
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
DefaultPrinter = .cDefaultprinter
End With
ActiveSheet.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
.cClose
End With
Set pdfjob = Nothing
MsgBox ("Le nom de votre fichier : " & NomPdf)
End Sub


Sub Impression()
'
' Impression de la feuille
'
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub

 

[casamartin]

Re : macro excel impression PDF

Ce programme va sur différents PC en réseau et je ne connais pas les imprimantes par défaut de chacun.

 

[casamartin]

Re : macro excel impression PDF

N'ayant pas eu de réponse j'ai revu la macro de Bebere et j'y est trouvé les 3 lignes de code pour revenir à l'imprimante par défaut sur excel.

Voici la macro complète qui fonctionne, tout ça à cause de mes clients qui sont encore sur excel 2003,+ macro pour excel2007 4 lignes suffisaient
S'il y a quelques anomalies elle ne sont pas importantes
Reste à tester chez mon client sur 2003.

Function ExistenceFichier(sFichier As String) As Boolean
ExistenceFichier = Dir(sFichier) <> ""
End Function
Sub ImprPdf2003()
'
' Edition devis pour mail
'


Dim Rep As Long
Dim pdfjob As Object
Dim myprint As String
Dim Port As Integer
Dim fichname As String
Dim NomPdf As String
Dim DefaultPrinter As String
DefaultPrinter = Application.ActivePrinter

For Port = 0 To 9
myprint = "PDFCreator sur Ne0" & Port & ":"
On Error Resume Next
ActivePrinter = myprint
If ActivePrinter = myprint Then
Exit For
End If
Next
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox " PDFCreator n'a pu être démarrer.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
End With
NomPdf = ActiveSheet.Range("M1") & ".pdf"
fichname = ThisWorkbook.Path & "\" & NomPdf
If ExistenceFichier(fichname) Then
Rep = MsgBox("Le fichier existe déjà" & vbCrLf & "L'écraser ?", vbYesNo)
End If

If Rep = 7 Then Exit Sub

With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutisaveDirectory") = 1
.cOption("AutosaveDirectory") = (ThisWorkbook.Path)
.cOption("AutosaveFilename") = NomPdf
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
With pdfjob
.cClearCache
.cClose
End With
Set pdfjob = Nothing
MsgBox ("Le nom de votre fichier : " & NomPdf)
Application.ActivePrinter = DefaultPrinter
End Sub

Macro pour 2007

Sub imprPdf2007()
'
' Edition devis pour mail
'
Dim nom As String
Range("M1").Select
nom = ThisWorkbook.Path & "\" & ActiveCell.Text & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nom _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

 

[kiki29]

Re : macro excel impression PDF

re,tu definis une variable sPrinter et lui affecte l'imprimante par défaut en début de procédure et tu rétablis ce réglage en fin

Dim sPrinter As String

    sPrinter = Application.ActivePrinter

    '....... code

    Application.ActivePrinter = sPrinter

PS sur https://www.excel-downloads.com/threads/macro-impression-recto-verso-sur-excel.32694/ tu pourrais avoir la politesse d'effacer le contenu de ton post sans rapport

Tu n'as toujours strictement rien compris au balisage de code

 

[casamartin]

Re : macro excel impression PDF

j'avais cru que le balisage été un mot technique de processus macro.

Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir(sFichier) <> ""
End Function

c'est en recherchant et l'aide que tu m'a apportée que l'on progresse.

merci pour tout.