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
| Sub SautDePage()
'
' Saut De Page Macro
' Macro enregistrÈe le 22/06/2010
' Touche de raccourci du clavier: Ctrl+w
'
Dim hpbLine() As Variant, B1 As Integer, intVal As Integer
hpbLine = Array(1587, 1525, 1463, 1401, 1339, 1277, 1215, 1153, 1091, 1029, 967, 905, 843, 781, 719, 657, 595, 533, 471)
ActiveSheet.Unprotect Password:="good"
'Bloque le recalcul automatique ‡ chacune des opÈration
Application.Calculation = xlCalculationManual
'Fige l'Ècran pendant l'exÈcution des macros en arriËre plan
'Application.ScreenUpdating = False
'Supprime tous les sauts de page (pas ceux dÈlimitÈs par la zone d'impression)
ActiveSheet.ResetAllPageBreaks
'Met en place du saut de page vertical
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Columns(49)
'Met en place des sauts de page de la partie sous-traitant sans rÈvision
If Range("CS2").Value = "0" And Range("CS3").Value = "1" Then
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Columns(97)
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Columns(145)
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(265)
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(327)
End If
'Met en place du saut de page 2 conditions : rÈvision + sous traitants
If Range("CS2").Value = "1" And Range("CS3").Value = "1" Then
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Columns(97)
ActiveWindow.SelectedSheets.VPageBreaks.Add Before:=Columns(145)
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(265)
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(327)
End If
'Met en place des sauts de page de la partie dqe
intVal = CInt(Range("Av5").Value)
If intVal >= 2 And intVal <= 20 Then
For B1 = 0 To intVal - 2
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(hpbLine(B1))
Next
End If
'Met en place du saut de page de la partie avenant 1 ‡ 2
If Range("CS4").Value = "2" Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(1649)
End If
'Met en place du saut de page de la partie avenant 1 ‡ 5
If Range("CS4").Value = "1" Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(1649)
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Rows(1711)
End If
'LibËre l'Ècran aprËs l'exÈcution des macros en arriËre plan
Application.ScreenUpdating = True
'DÈbloque le recalcul automatique ‡ chacune des opÈration
Application.Calculation = xlCalculationAutomatic
ActiveSheet.Protect Password:="good", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Range("A1").Select
End Sub |
Ordre des pages avec saut VBA
Répondre avec citation
Partager