XL 2010 Imprimer 3 pages depuis une autre page

[Orson83]

Bonsoir la communauté,
J'aimerai pouvoir imprimer 3 pages depuis une autre page.
Je m'explique : en étant sur l'onglet "Accueil", je souhaiterai que 3 autres onglets soient imprimés.
J'ai préparé du code dans le Module1 mais il ne fonctionne pas.
Merci pour votre aide.
Je joins mon fichier Excel 2010 dans ce post.
PS : ne pas utiliser la position des onglets car ils pourront être déplacés. Merci
François

 

[job75]

Votre fichier en retour avec cette macro :

Sub ButtonPrintStats()
Dim feuilles, zones, LMargin, RMargin, TMargin, BMargin, etat(), n%
feuilles = Array("Stats population", "Stats métiers", "Stats générales")
zones = Array("C4:M26", "D5:N27", "E6:O28")
LMargin = Array(0.7, 0.8, 0.9)
RMargin = Array(0.1, 0.2, 0.3)
TMargin = Array(0.7, 0.8, 0.9)
BMargin = Array(0.7, 0.8, 0.9)
ReDim etat(UBound(feuilles))
For n = 0 To UBound(feuilles)
    With Worksheets(feuilles(n)).PageSetup
        etat(n) = .Parent.Visible 'mémorise l'état
        .Parent.Visible = xlSheetVisible 'si la feuille est masquée
        .PrintArea = zones(n)
        .LeftMargin = Application.InchesToPoints(LMargin(n)) 'Marge gauche
        .RightMargin = Application.InchesToPoints(RMargin(n)) 'Marge droite
        .TopMargin = Application.InchesToPoints(TMargin(n)) 'Marge haut de page ou top
        .BottomMargin = Application.InchesToPoints(BMargin(n)) 'Marge bas de page si nécessaire
        .Orientation = xlLandscape 'Paysage
    End With
Next
Worksheets(feuilles).PrintPreview 'Aperçu pour tester
'Worksheets(feuilles).PrintOut 'Pour imprimer
'---Remise en l'état initial---
For n = 0 To UBound(feuilles)
    Worksheets(feuilles(n)).Visible = etat(n)
Next
End Sub

 

[Orson83]

Votre fichier en retour avec cette macro :

Sub ButtonPrintStats()
Dim feuilles, zones, LMargin, RMargin, TMargin, BMargin, etat(), n%
feuilles = Array("Stats population", "Stats métiers", "Stats générales")
zones = Array("C4:M26", "D5:N27", "E6:O28")
LMargin = Array(0.7, 0.8, 0.9)
RMargin = Array(0.1, 0.2, 0.3)
TMargin = Array(0.7, 0.8, 0.9)
BMargin = Array(0.7, 0.8, 0.9)
ReDim etat(UBound(feuilles))
For n = 0 To UBound(feuilles)
    With Worksheets(feuilles(n)).PageSetup
        etat(n) = .Parent.Visible 'mémorise l'état
        .Parent.Visible = xlSheetVisible 'si la feuille est masquée
        .PrintArea = zones(n)
        .LeftMargin = Application.InchesToPoints(LMargin(n)) 'Marge gauche
        .RightMargin = Application.InchesToPoints(RMargin(n)) 'Marge droite
        .TopMargin = Application.InchesToPoints(TMargin(n)) 'Marge haut de page ou top
        .BottomMargin = Application.InchesToPoints(BMargin(n)) 'Marge bas de page si nécessaire
        .Orientation = xlLandscape 'Paysage
    End With
Next
Worksheets(feuilles).PrintPreview 'Aperçu pour tester
'Worksheets(feuilles).PrintOut 'Pour imprimer
'---Remise en l'état initial---
For n = 0 To UBound(feuilles)
    Worksheets(feuilles(n)).Visible = etat(n)
Next
End Sub

SUPER, merci d'avoir abrégé mes souffrances.

J'ai remarqué que les pages s'ajustent à l'impression même si la zone est trop grande, donc inutile d'insérer des :

.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1

C'est parfait.

Désolé pour mes nombreuses sollicitations et merci pour le temps passé.

Très belle soirée.

François

 

[Phil69970]

Bonjour Tchotchodu31 , Job75, le forum

A copier dans un module
Ce code fonctionne chez moi

' A mettre dans un Module
'****************************************
'IMPRIMER 3 PAGES DEPUIS LA PAGE ACCUEIL
'****************************************
Sub ButtonPrintStats()

Application.ScreenUpdating = False
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim Sh4 As Worksheet

Set Sh2 = Feuil2                'Codename de la feuille "Stats population"
Set Sh3 = Feuil3                'Codename de la feuille "Stats métiers"
Set Sh4 = Feuil4                'Codename de la feuille "Stats générales"

With Sh2.PageSetup
    .PrintArea = "C4:M26"       'Zone d'impression à adapter si besoin
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

With Sh3.PageSetup
    .PrintArea = "D5:N27"       'Zone d'impression à adapter si besoin
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

With Sh4.PageSetup
    .PrintArea = "E6:O28"       'Zone d'impression à adapter si besoin
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

For Each sh In Worksheets 'Reglage impr pour toutes les feuilles si reglages identiques
    'Réglage des marges
    sh.PageSetup.LeftMargin = Application.InchesToPoints(0.8)       'Marge gauche
    sh.PageSetup.RightMargin = Application.InchesToPoints(0.1)      'Marge droite
    sh.PageSetup.TopMargin = Application.InchesToPoints(0.8)        'Marge haut de page ou top
    sh.PageSetup.BottomMargin = Application.InchesToPoints(0.8)     'Marge bas de page si nécessaire
    sh.PageSetup.Orientation = xlLandscape                          'Paysage
   'sh.PageSetup.Orientation = xlPortrait                           'Portrait
Next sh

Sheets(Array(Sh2.Name, Sh3.Name, Sh4.Name)).PrintPreview            'Selectionne les feuille à prévisualiser

Set Sh2 = Nothing               'Decharge la feuille 2
Set Sh3 = Nothing               'Decharge la feuille 3
Set Sh4 = Nothing               'Decharge la feuille 4

Application.ScreenUpdating = True

End Sub

 

[Orson83]

Bonjour Tchotchodu31 , Job75, le forum

A copier dans un module
Ce code fonctionne chez moi

' A mettre dans un Module
'****************************************
'IMPRIMER 3 PAGES DEPUIS LA PAGE ACCUEIL
'****************************************
Sub ButtonPrintStats()

Application.ScreenUpdating = False
Dim Sh2 As Worksheet
Dim Sh3 As Worksheet
Dim Sh4 As Worksheet

Set Sh2 = Feuil2                'Codename de la feuille "Stats population"
Set Sh3 = Feuil3                'Codename de la feuille "Stats métiers"
Set Sh4 = Feuil4                'Codename de la feuille "Stats générales"

With Sh2.PageSetup
    .PrintArea = "C4:M26"       'Zone d'impression à adapter si besoin
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

With Sh3.PageSetup
    .PrintArea = "D5:N27"       'Zone d'impression à adapter si besoin
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

With Sh4.PageSetup
    .PrintArea = "E6:O28"       'Zone d'impression à adapter si besoin
    .FitToPagesWide = 1
    .FitToPagesTall = 1
End With

For Each sh In Worksheets 'Reglage impr pour toutes les feuilles si reglages identiques
    'Réglage des marges
    sh.PageSetup.LeftMargin = Application.InchesToPoints(0.8)       'Marge gauche
    sh.PageSetup.RightMargin = Application.InchesToPoints(0.1)      'Marge droite
    sh.PageSetup.TopMargin = Application.InchesToPoints(0.8)        'Marge haut de page ou top
    sh.PageSetup.BottomMargin = Application.InchesToPoints(0.8)     'Marge bas de page si nécessaire
    sh.PageSetup.Orientation = xlLandscape                          'Paysage
   'sh.PageSetup.Orientation = xlPortrait                           'Portrait
Next sh

Sheets(Array(Sh2.Name, Sh3.Name, Sh4.Name)).PrintPreview            'Selectionne les feuille à prévisualiser

Set Sh2 = Nothing               'Decharge la feuille 2
Set Sh3 = Nothing               'Decharge la feuille 3
Set Sh4 = Nothing               'Decharge la feuille 4

Application.ScreenUpdating = True

End Sub

Bonjour Phil69970 , Job75,

Cette macro fonctionne très bien. Néanmoins je remarque un temps de latence plus important et un blocage quand certains onglets sont masqués. Ceci dit, le fait de ne pas avoir à nommer systématiquement les feuilles est une bonne chose.

Je pense que tu as lu le post en cours de route.

Merci pour ta contribution.

François

 

[Phil69970]

Bonjour Tchotchodu31 , Job75, le forum

C'est vrai que c'est un peu lent pour avoir la visualisation.
Il y a surement possibilité d'optimiser un peu (beaucoup) plus le code.

Je préfère souvent ne pas nommer les feuilles cela permet à tout le monde de récupérer le code facilement sans presque rien changer.
Et j'essaie de le commenter pour sa lisibilité.

C'est vrai que j'ai pris le post en cours de route....Ok c'est pas bien.

Cordialement

 

[kiki29]

Salut, voir plus haut et ici
bis repetita placent .....

Possibilité de fusion en 1 seul pdf de l'ensemble des feuilles, ou de génération des feuilles sélectionnées de façon séparée, de gestion des doublons via un indice, le tout dans un dossier créé automatiquement et nommé par défaut Dossier PDFs à la racine de l'application. L'ensemble des feuilles ( visibles ou pas ) est listé via le bouton Récap.