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

  • Initiateur de la discussion Initiateur de la discussion KTM
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

KTM

XLDnaute Impliqué
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
 

Pièces jointes

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.
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
1 K
Réponses
0
Affichages
929
Réponses
4
Affichages
680
Réponses
3
Affichages
905
Retour