XL 2016 concours / Macro imprimer le texte au maximum selon les pages

berru76

XLDnaute Occasionnel
Bonjour
cette macro a été faite avec enregistrer (je sais pas performante mais incapable de faire mieux)
J'ai plusieurs pages qui utilisent cette macro
Comment l'améliorer pour que l'impression du texte soit adapter : centrer et au maximum de la page en cours
Merci a vous

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX


VB:
Sub Imprimer1tour()
'
   Application.ScreenUpdating = False
   Range("AH2:AM33").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(2.75590551181102)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    Selection.PrintOut Copies:=1, Collate:=True
    Application.ScreenUpdating = True
End Sub
[/CODE]
 
Dernière édition:
Solution
Bonjour à tous

@berru76

Je te propose ce code à mettre dans un module (tout le code est commenté)

VB:
Sub Impression()
Application.ScreenUpdating = False
With ActiveSheet                                        ' Les paramètres s'applique à la feuille active
    With .PageSetup
      
        '******** Zone d'impression
        .PrintArea = "AH2:AM28"                         ' A adapter si besoin
        '********
      
        .Orientation = xlPortrait                       ' Portait ou  xlLandscape paysage
        .CenterHorizontally = True                      ' Centré horizontalement
        .CenterVertically = True                        ' Centré verticalement
        .LeftMargin = Application.InchesToPoints(0)     ' Marge...

Mike57000

XLDnaute Nouveau
Bonjour,
pour que ma macro fonctionne, il faut définir une zone d'impression :
ActiveSheet.PageSetup.PrintArea = "$H$2:$M$33"
Puis mettre les paramètres
.LeftMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True

pour obtenir le résultat souhaité.
 

berru76

XLDnaute Occasionnel
Bonjour,
pour que ma macro fonctionne, il faut définir une zone d'impression :
ActiveSheet.PageSetup.PrintArea = "$H$2:$M$33"
Puis mettre les paramètres
.LeftMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.CenterVertically = True

pour obtenir le résultat souhaité.
Bonjour
j ai testé votre solution je me suis peut être trompé mais la macro m'annonce une erreur de compilation du a une référence incorrect ou non qualifiée
je vous joint un modèle avec la macro d'origine et votre solution
si vous pouvez me corriger
Merci a vous
 

Pièces jointes

  • Essai imprimer.xlsm
    445.7 KB · Affichages: 8

Phil69970

XLDnaute Barbatruc
Bonjour à tous

@berru76

Je te propose ce code à mettre dans un module (tout le code est commenté)

VB:
Sub Impression()
Application.ScreenUpdating = False
With ActiveSheet                                        ' Les paramètres s'applique à la feuille active
    With .PageSetup
      
        '******** Zone d'impression
        .PrintArea = "AH2:AM28"                         ' A adapter si besoin
        '********
      
        .Orientation = xlPortrait                       ' Portait ou  xlLandscape paysage
        .CenterHorizontally = True                      ' Centré horizontalement
        .CenterVertically = True                        ' Centré verticalement
        .LeftMargin = Application.InchesToPoints(0)     ' Marge gauche
        .RightMargin = Application.InchesToPoints(0)    ' Marge droite
        .TopMargin = Application.InchesToPoints(0)      ' Marge haut
        .BottomMargin = Application.InchesToPoints(0)   ' Marge bas
        .Zoom = False                                   ' Pas de zoom
        .FitToPagesTall = 1                             ' 1 page en hauteur
        .FitToPagesWide = 1                             ' 1 page en largeur
    End With
    .PrintPreview                                       ' Prévisualisation à supprimer éventuellement
    .PrintOut                                           ' Impression
End With
End Sub

Merci de ton retour
 

bsalv

XLDnaute Occasionnel
bonjour,
Enrichi (BBcode):
Sub Imprimer1tour1028BIS()
     '
     Application.ScreenUpdating = False
     With ActiveSheet.PageSetup
          .PrintArea = "$AH$2:$BM$33"
          .LeftMargin = Application.InchesToPoints(0)
          .TopMargin = Application.InchesToPoints(0)
          .RightMargin = Application.InchesToPoints(0)
          .BottomMargin = Application.InchesToPoints(0)
          .CenterHorizontally = True
          .CenterVertically = True
          .Zoom = False
          .FitToPagesWide = 1
          .FitToPagesTall = 1
     End With
     ActiveSheet.PrintPreview
     Application.ScreenUpdating = True
End Sub
 

bsalv

XLDnaute Occasionnel
Excel fait son mieux avec ceci, donc 1 page en hauteur et 1 page en largeur, sans "zoom"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
Ce que vous pouvez faire, c'est manuellement changer cela, donc choisir pour le "zoom" et l'augmenter petit à petit, jusau'au moment ou excel a besoin de 2 pages.
Ou vous pouvez choisir l'autre orientation "xlLandscape"
.Orientation = xlPortrait ' Portait ou xlLandscape paysage

il n'y a pas un zoom vertical ou horizontal, c'est les 2 ensemble.
 

Phil69970

XLDnaute Barbatruc
Re

un zoom vertical automatique adapté a la page

Ceci correspond au plus près de ce que tu demandes

1692003588113.png
 

berru76

XLDnaute Occasionnel
Merci a vous vos solutions sont bonnes toutes les deux
Je pense que je vais faire plusieurs macros sur votre base avec des zooms selon un nombre de pages
le placement des joueurs étant automatique selon les résultats pour le tour suivant / afficher les tours suivant vide ne me semble pas utile mais sera certainement adapter pour un autre fichier
un grand bravo pour votre travail
 

bsalv

XLDnaute Occasionnel
bonjour,
Vous pouvez créer une macro standard avec un paramètre, la plage et puis quelque macros avec chaque fois une autre plage.
Si nécessaire, on peut ajouter un 2ième variabe (par exemple si le zoom change) etc

Enrichi (BBcode):
Sub Imprimer_1()
     Imprimer Sheets("Feuil1").Range("AH2:BM33")
End Sub

Sub Imprimer_2()
     Imprimer Sheets("Feuil2").Range("A2:Z33")
End Sub


Sub Imprimer(Plage As Range)
     With Plage.Parent     '=la feuille
          With .PageSetup
               .PrintArea = Plage.Address 'la plage
               .LeftMargin = Application.InchesToPoints(0)
               .TopMargin = Application.InchesToPoints(0)
               .RightMargin = Application.InchesToPoints(0)
               .BottomMargin = Application.InchesToPoints(0)
               .CenterHorizontally = True
               .CenterVertically = True
               .Zoom = False
               .FitToPagesWide = 1
               .FitToPagesTall = 1
          End With
          .PrintPreview
          '.PrintOut
     End With
End Sub
 

Statistiques des forums

Discussions
313 230
Messages
2 096 413
Membres
106 608
dernier inscrit
Jeanluc.chilond