Bonjour,

testé sous 2000, 2003 & 2007.

La macro suivante permet d’imprimer une feuille Worksheet d’un classeur en paramétrant des en-têtes et des pieds de pages différents pour chaque page imprimée.
Elle utilise pour ce faire la gestion des sauts de page et définit une zone d’impression pour chaque page trouvée pour laquelle on peut définir les en-têtes ou pieds désirés.
Par défaut, on n'imprime pas les pages vierges générées.
Ici les en-têtes - pieds voulus sont stockés en Feuil2 : cells(x,1) = en-tête page x, cells(x,2) = pied page x etc...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Option Explicit
Option Base 1
Dim objFeuilCible As Worksheet
 
Sub ImpressSpecial()
'code Didier Gonard
'Attention à HPageBreaks, ou VPageBreaks.Location ou .Count, il y a des bugs officiels !
'Remarque  Une feuille ne peut pas contenir plus de 1 000 sauts de page horizontaux et Verticaux (aide vba - limites et spécifications).
'on ne considère ici que les feuilles de calcul - worksheets - pas testé en dehors.
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim intIndexPage As Integer
Dim intNbSautsVer As Integer
Dim intNbSautsHor As Integer
Dim lngNumDerLigne As Long 'penser 2007
Dim intNumDerCol As Integer
Dim intTotalPgeImp As Integer
Dim objShapeLimiteVer As Range
Dim objShapeLimiteHor As Range
Dim intMemoryHor As Integer
Dim intMemoryVer As Integer
Dim tabvarSautsV() As Variant
Dim tabvarSautsH() As Variant
Dim tabvarPrintArea() As Variant
 
Set objFeuilCible = Worksheets(1)
ActiveWindow.View = xlNormalView 'affichage normal par défaut
' Initialisation des paramètres utiles
With objFeuilCible
    .PageSetup.PrintArea = "" 'par défaut annule zone d'impression
    .Cells(Rows.Count, Columns.Count).Select 'Anti buggage selon support Microsoft
    lngNumDerLigne = .Cells(Rows.Count, 1).End(xlUp).Row
    intNumDerCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    intNbSautsVer = .VPageBreaks.Count
    intNbSautsHor = .HPageBreaks.Count
End With
intTotalPgeImp = ExecuteExcel4Macro("Get.Document(50)") 'on utilise une macro Excel4.
 
'Recherche et définition de la limite verticale, on ajoute des données à partir de
'la dernière cellule, quand un saut de page sup est généré, c'est qu'on a atteint la limite de notre surface utile
'on utilise la macro Excel4.
While intTotalPgeImp >= ExecuteExcel4Macro("Get.Document(50)")
    Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1) = "zzzzz"
Wend
Set objShapeLimiteVer = Cells(1, Columns.Count).End(xlToLeft).Offset(0, -1)
'on fait le ménage
Range(Cells(1, intNumDerCol + 1), Cells(1, Columns.Count).End(xlToLeft)).ClearContents
 
'Recherche et définition de la limite horizontale
While intTotalPgeImp >= ExecuteExcel4Macro("Get.Document(50)")
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = "zzzzz"
Wend
Set objShapeLimiteHor = Cells(Rows.Count, 1).End(xlUp).Offset(-1, 0)
Range(Cells(lngNumDerLigne + 1, 1), Cells(Rows.Count, 1).End(xlUp)).ClearContents
 
'Mise en tableau des cellules corner de sauts de page Verticaux
ReDim tabvarSautsV(intNbSautsVer)
For I = 1 To intNbSautsVer
Set tabvarSautsV(I) = ActiveSheet.VPageBreaks(I).Location.Offset(0, -1)
Next I
'Si le dernier saut ne coïncide pas avec la limite(cas ou la dernière donnée est en limite=>saut vide généré), on ajoute un item
If tabvarSautsV(intNbSautsVer).Address <> objShapeLimiteVer.Address Then ReDim Preserve tabvarSautsV(intNbSautsVer + 1): Set tabvarSautsV(intNbSautsVer + 1) = objShapeLimiteVer
 
'Mise en tableau des cellules corner de sauts de page Horizontaux
ReDim tabvarSautsH(intNbSautsHor)
For J = 1 To intNbSautsHor
Set tabvarSautsH(J) = ActiveSheet.HPageBreaks(J).Location.Offset(-1, 0)
Next J
'Si le dernier saut ne coïncide pas avec la limite(cas ou la dernière donnée est en limite=>saut vide généré), on ajoute un item
If tabvarSautsH(intNbSautsHor) <> objShapeLimiteHor Then ReDim Preserve tabvarSautsH(intNbSautsHor + 1): Set tabvarSautsH(intNbSautsHor + 1) = objShapeLimiteHor
 
'par défaut, pour simplifier, on prend un nombre de feuilles imprimées maxi, ce qui génère des feuilles vierges, ce que fait excel de façon variable selon les cas
ReDim tabvarPrintArea(UBound(tabvarSautsV) * UBound(tabvarSautsH))
'on met les Print area en tableau, et on traite ensuite = souplesse pour ajouts possibles
K = 1
For J = 1 To UBound(tabvarSautsV)
    intMemoryHor = 0
    For I = 1 To UBound(tabvarSautsH)
        tabvarPrintArea(K) = Cells(tabvarSautsH(I).Row, tabvarSautsH(I).Column + intMemoryVer).Address & ":" & Cells(tabvarSautsV(J).Row + intMemoryHor, tabvarSautsV(J).Column).Address
       K = K + 1
       intMemoryHor = tabvarSautsH(I).Row
    Next I
    intMemoryVer = tabvarSautsV(J).Column
Next J
With objFeuilCible
    For I = 1 To UBound(tabvarPrintArea)
        .PageSetup.PrintArea = ""
        .PageSetup.PrintArea = tabvarPrintArea(I)
        If PageVierge(I, tabvarPrintArea) = False Then 'on peut faire sauter l'appel à la fonction qui évite l'impression des pages vierges si voulu
            intIndexPage = intIndexPage + 1 'ici on choisi de gérer les Nos de page en ne tenant compte que des non vierges
            .PageSetup.CenterHeader = Worksheets(2).Cells(intIndexPage, 1) ' on fait ce que l'on veut au niveau de en-tête & pieds de page
            .PageSetup.CenterFooter = Worksheets(2).Cells(intIndexPage, 2) 'ici, on agit sur les center Header-Footer stockés en feuille 2
            .PrintPreview 'on fait juste un preview ici, cliquer sur fermer pour avancer page par page à l'affichage
'            .PrintOut ''ou bien ceci pour imprimer sur l'imprimante par défaut...En imp virtuelle pdf => 1 fichier par page...
        End If
    Next I
    .Cells(1, 1).Select
    .PageSetup.PrintArea = "" 'on annule la zone d'impression
End With
Set objFeuilCible = Nothing
End Sub
Function PageVierge(I As Integer, tabvarPrintArea As Variant) As Boolean
Dim objShape As Shape
 
With objFeuilCible
    'avec countA, on vérifie l'absence de données et du coup on teste si le feuille comporte des Shapes...
    If Application.CountA(.Range(tabvarPrintArea(I))) = 0 Then
        'Si pas de données et pas de shapes...la page est déclarée vierge
        If objFeuilCible.Shapes.Count = 0 Then PageVierge = True: Exit Function
        'si pas de données mais des Shapes, on vérifie que tout ou partie d'une shape ne se trouve pas sur la zone d'impression
        For Each objShape In .Shapes '
            If Not Intersect(Range(objShape.TopLeftCell.Address & ":" & objShape.BottomRightCell.Address), .Range(tabvarPrintArea(I))) Is Nothing Then
                Exit Function 'si c'est le cas, on sort
            End If
        Next objShape
        PageVierge = True  'sinon la page est déclarée vierge
    End If
End With
End Function
cordialement,

Didier