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

[berru76]

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

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]

 

[Mike57000]

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]

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

 

[Phil69970]

Bonjour à tous

@berru76

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

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]

bonjour,

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

 

[berru76]

Bonjour
j'ai tester vos deux solutions fonctionnent
si je n'abuse pas serait t il possible d'ajouter un zoom vertical automatique adapté a la page
un grand merci pour votre aide

 

[bsalv]

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]

Re

un zoom vertical automatique adapté a la page

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

 

[berru76]

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]

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

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

 

[berru76]

Bonjour
tester fonctionne bien mais ayant 50 feuilles
Je pense que je vais adapter le zoom toutes les dix feuilles
Merci a tous