XL 2013 Enregistrement en PDF

[STARRAG]

Bonjour à tous,

J'ai besoin de votre aide pour savoir s'il existe une solution concernant ma macro.
J'utilise une macro pour enregistrer mon tableau excel en pdf via cette macro:

Sub PDF_ENREGISTRER()

Dim LHeure As String, LeDate As String

LHeure = Format(Time, "HMS")
LaDate = Format(Date, "dd" & "." & "mm" & "." & "yyyy")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"P:\ " & LaDate & " " & LHeure & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=18, OpenAfterPublish:=False

End Sub

Cependant, je suis obligé de modifier le nombre de page à créer sur le pdf à chaque fois que mon tableau s'agrandit.
A t'il une solution pour qu'il s'adapte automatiquement?

Merci d'avance de votre aide.
Cordialement

 

[michokette]

Bonjour à tous,

J'ai besoin de votre aide pour savoir s'il existe une solution concernant ma macro.
J'utilise une macro pour enregistrer mon tableau excel en pdf via cette macro:

Sub PDF_ENREGISTRER()

Dim LHeure As String, LeDate As String

LHeure = Format(Time, "HMS")
LaDate = Format(Date, "dd" & "." & "mm" & "." & "yyyy")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"P:\ " & LaDate & " " & LHeure & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
From:=1, To:=18, OpenAfterPublish:=False

End Sub

Cependant, je suis obligé de modifier le nombre de page à créer sur le pdf à chaque fois que mon tableau s'agrandit.
A t'il une solution pour qu'il s'adapte automatiquement?

Merci d'avance de votre aide.
Cordialement

 

[michokette]

a essayer
Sub PDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "dd\_mm\_yyyy\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="Fichier PDF (*.pdf), *.pdf", _
Title:="Selectionnez Un Repertoire pour la Sauvegarde")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "Fichier PDF Crée: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Impossible de créer le Fichier PDF"
Resume exitHandler


End Sub

 

[Phil69970]

Bonjour Starrag, le forum

Que se passe t'il si tu ne mets pas les arguments From et To.


Range.ExportAsFixedFormat, méthode

From	Facultatif	Variante	Numéro de la page à partir de laquelle commence la publication. Si cet argument est omis, la publication commence à la première page.
To	Facultatif	Variante	Numéro de la dernière page à publier. Si cet argument est omis, la publication se termine à la dernière page.

@Phil69970

 

[STARRAG]

Bonjour,

Merci michokette et Phil69970, mais apparemment, je dois avoir un problème sur mon tableau excel.
Lorsque je lance la macro de michoquette ou que je modifie ma macro selon les conseils de Phil69970, un pdf s'ouvre avec 36 pages alors que 18 étaient nécessaire...
En rajoutant un filtre sur mon tableau, le pdf s'ouvre avec 8 pages alors que 4 étaient nécessaire...

 

[kiki29]

Salut, ici en Portrait A4 avec 62 lignes par page, à tester et adapter à ton contexte.
Un échantillon de ton tableau aiderait.

Option Explicit

Sub Impression()
Dim sFichier As String, LastRow As Long, Nb As Long

    sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    'LastRow = Feuil1.UsedRange.Rows.Count
    Nb = LastRow \ 62
    If LastRow Mod 62 > 0 Then Nb = Nb + 1

    Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                               Filename:=sFichier, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               From:=1, To:=Nb, _
                               OpenAfterPublish:=False
End Sub

 

[STARRAG]

Bonjour Kiki29, la macro que tu me proposes me bloque à 10 pages (sur les 18)
Ci joint le fichier excel

 

[kiki29]

Re, ceci devrait fonctionner, elle me sort 21 pages.

Option Explicit

Sub Impression()
Dim sFichier As String, Nb As Long, LastRow As Long

    sFichier = ThisWorkbook.Path & "\" & "Test_NbPages.pdf"

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    Feuil1.PageSetup.PrintArea = "$A$4:$X$" & LastRow

    Nb = Feuil1.HPageBreaks.Count + 1

    Feuil1.ExportAsFixedFormat Type:=xlTypePDF, _
                               Filename:=sFichier, _
                               Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, _
                               IgnorePrintAreas:=False, _
                               From:=1, To:=Nb, _
                               OpenAfterPublish:=False
End Sub

 

[STARRAG]

C'est parfait ! Merci beaucoup à tous!

 

[kiki29]

Re, j'ai complété mon post en y ajoutant ceci :

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    Feuil1.PageSetup.PrintArea = "$A$4:$X$" & LastRow

 

[Phil69970]

Bonjour Starrag, michockette, Kiki29

Si tu supprimes l'option ==> "To:= XX ," (XX = le nbre de page ou la variable NB dans le code de kiki29) ton pdf est bien crée avec la totalité des pages quelque soit la longueur de ton tableau le nombre de page s'adapte automatiquement.

Si tu fais le test ton tableau actuellement à 610 lignes (603 demandes) et 18 pages en pdf.
Si tu rajoutes 100 lignes ton tableau passent à 710 lignes (703 demandes) et 21 pages en pdf.

@Phil69970

 

[STARRAG]

Bonjour Phil69970,

Sur le fichier excel original, il me créé le double de page pdf même si j'enlève la fonction TO:= xx
Je pense que j'ai eu un problème sur le tableau excel.
J'ai repris l'intégralité du fichier et maintenant, ça fonctionne correctement.

 

[Phil69970]

Starrag, michockette, Kiki29

Si j'ai compris ta réponse ce code fonctionne ?

Option Explicit

Sub Impression()
Dim sFichier As String, Nb As Long, LastRow As Long

sFichier = ThisWorkbook.Path & "\" & "Test_NbPages.pdf"

Feuil1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFichier, Quality:=xlQualityStandard, _
                               IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                               From:=1, OpenAfterPublish:=False
End Sub

@Phil69970

 

[STARRAG]

Oui exactement, ce code fonctionne parfaitement !