XL 2016 Sauvegarder plages non contiguës d'une même feuille

[KTM]

Bonsoir Cher Forum
Pour sauvegarder deux plages situées sur la même feuille j'ai procédé comme suit:
-Une macro pour chaque plage
-Une macro qui fait appel aux deux premières
Mon souci est que ma principale plage la plus longe sort presque illisible
Voici mes codes et le Fichier joint:

Dim dossier$
Dim chemin As String, p, p1 As Range, x As Variant, dl As Long
Dim f As Worksheet, NomPDF$

Sub SAVE_RDV_ATTENDUS()
Application.ScreenUpdating = False

Set f = Sheets("RDV")
Set p = f.Range("A1", f.Cells(Rows.Count, "H").End(3))
dl = f.Range("A" & Rows.Count).End(xlUp).Row
ActiveWindow.View = xlNormalView
With f.PageSetup
.PrintArea = ""
.CenterHeader = ""
.RightHeader = ""
.RightFooter = ""
.PrintArea = "$A$1:$H$" & dl
End With
Worksheets("RDV").Columns("A:H").AutoFit

chemin = ThisWorkbook.Path & "\RDV_PREVUS\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin

NomPDF = "Liste des RDV "
f.PageSetup.FitToPagesWide = 1
f.PageSetup.RightFooter = "&P de &N"
f.PageSetup.CenterHeader = "RENDEZ_VOUS ATTENDUS "
p.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & NomPDF, Quality:=xlQualityStandard

Set f = Nothing
Set p = Nothing
End Sub
...........................................................................................................................................................................
Sub SAVE_RESUME_RDV_ATTENDUS()
Application.ScreenUpdating = False

Set f = Sheets("RDV")
Set p = f.Range("P1:S13")
ActiveWindow.View = xlNormalView
With f.PageSetup
.PrintArea = ""
.CenterHeader = ""
.RightHeader = ""
.RightFooter = ""
.PrintArea = "$P$1:$S$13"
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With

chemin = ThisWorkbook.Path & "\RDV_PREVUS\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin

NomPDF = "Resumé des RDV "
f.PageSetup.PrintArea = "P1:S" & f.Range("P" & Rows.Count).End(xlUp).Row
f.PageSetup.CenterHeader = " NOMBRE DE PATIENTS ATTENDUS PAR PROTOCOLE "
p.ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & NomPDF, Quality:=xlQualityStandard
Set f = Nothing
Set p = Nothing
End Sub
.........................................................................................................................................................................
Sub SAVE()
Call SAVE_RDV_ATTENDUS
Call SAVE_RESUME_RDV_ATTENDUS
End Sub

 

[TooFatBoy]

Bonjour,

Essaye d'ajouter, après la ligne f.PageSetup.FitToPagesWide = 1 dans ta première macro :
f.PageSetup.FitToPagesTall = False


PS : même remarque que précédemment : tu peux utiliser la balise code=vb pour améliorer la lecture de tes macros sur le forum.

 

[KTM]

Bonjour,

Essaye d'ajouter, après la ligne f.PageSetup.FitToPagesWide = 1 dans ta première macro :
f.PageSetup.FitToPagesTall = False


PS : même remarque que précédemment : tu peux utiliser la balise code=vb pour améliorer la lecture de tes macros sur le forum.

Merci

 

[TooFatBoy]

De rien.

Euh... ça donne ce que tu voulais, au moins ???

 

[KTM]

Un

De rien.

Euh... ça donne ce que tu voulais, au moins ???

Exactement
Merci