Le but : Incrémenter le N° de page quelque soit l'emplacement des plages à éditer.
Première méthode : Les feuilles et plages de cellules à éditer sont connues.
Les tableaux "Plage1" et "Plage2" correspondent respectivement aux plages des feuilles feuil1 et feuil2 à éditer
Autant de tableaux "Plage" que de feuilles de calculs
Le tableau feuil contient le nom des feuilles de calculs concernées ->
feuil = Array("feuil1", "feuil2", "feuiln")
Le tableau de tableaux (Tablo) doit comporter autant de tableaux que de feuilles ->
Tablo = array(Plage1, Plage2, Plagen)
Cet exemple comporte 6 plages de cellules réparties dans deux feuilles.
Seconde méthode : Les plages de cellules à éditer sont sélectionnées dans les feuilles de calculs
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 Sub Test1() Dim feuil As Variant, FL1 As Worksheet Dim Plage1, Plage2, i As Byte, j As Byte, k As Byte Application.ScreenUpdating = False feuil = Array("feuil1", "feuil2") 'Première feuille Plage1 = Array("$A$1:H30", "$C$32:$G64", "$E$68:$L$85") 'plage de la feuille feuil(0) 'seconde feuille Plage2 = Array("$B$10:J40", "$A$44:$I74", "$A$78:$L$97") 'plage de la feuille feuil(1) Tablo = Array(Plage1, Plage2) 'k = 0 For i = 0 To UBound(Plage1) - 1 Set FL1 = Worksheets(feuil(k)) With FL1 For j = 0 To UBound(Plage2) NoPage = NoPage + 1 With .PageSetup .PrintArea = Tablo(i)(j) .CenterHorizontally = True .CenterVertically = True .FitToPagesWide = 1 .FitToPagesTall = 1 .Orientation = xlPortrait ' ou xlLandscape (paysage) .CenterHeader = "Page " & CStr(NoPage) End With .PrintPreview 'juste pour vérifier la validité du code '.PrintOut 'valider cette ligne pour éditer les pages Next End With Set FL1 = Nothing k = k + 1 Next Application.ScreenUpdating = True End Sub
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 Sub Test2() Dim feuil As Variant, FL1 As Worksheet Dim Plage As Range, k As Byte, NoPage On Error Resume Next NoPage = 1 Set Plage = Application.InputBox("Sélectionner la plage à éditer, page " & vbCr _ & NoPage & vbCr & "Pour quitter sans sélection, sélectionner ANNULER", _ "SELECTION D'UNE PLAGE", Type:=8) Do While Not Plage Is Nothing Application.ScreenUpdating = False Set FL1 = ActiveSheet With FL1 With .PageSetup .PrintArea = Plage.Address .CenterHorizontally = True .CenterVertically = True .FitToPagesWide = 1 .FitToPagesTall = 1 .Orientation = xlPortrait ' ou xlLandscape (paysage) .CenterHeader = "Page " & CStr(NoPage) End With .PrintPreview 'juste pour vérifier la validité du code '.PrintOut 'valider cette ligne pour éditer les pages End With Set FL1 = Nothing Set Plage = Nothing NoPage = NoPage + 1 Application.ScreenUpdating = True Set Plage = Application.InputBox("Sélectionner la plage à éditer, page " & vbCr _ & NoPage & vbCr & "Pour quitter sans sélection, sélectionner ANNULER", _ "SELECTION D'UNE PLAGE", Type:=8) Loop On Error GoTo 0 End Sub
Partager