Public Sub InserST(Optional ByVal supprSautPage As Boolean) '(ByVal supprSautPage As Boolean)
Dim C As Range
Dim i As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Suppression des sous-totaux
With ActiveSheet.Range("$A$1:F" & Range("C" & Application.Rows.Count).End(xlUp).Row)
Do
Set C = .Find(What:="-Total", _
After:=Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False)
If Not C Is Nothing Then
Cells(C.Row, "A").EntireRow.Delete
End If
Loop While Not C Is Nothing
End With
ActiveSheet.ResetAllPageBreaks
While ActiveSheet.HPageBreaks.Count > 0 And i < 5
On Error Resume Next
ActiveSheet.HPageBreaks(1).Delete 'suppression des sauts de page horizontaux
On Error GoTo 0
i = i + 1
Wend
'ActiveSheet.Cells.PageBreak = xlPageBreakNone
Application.ScreenUpdating = True
' Partie 2 : Définition auto de la zone d'impression
ActiveSheet.PageSetup.PrintArea = "$A$1:F" & Range("E" & Application.Rows.Count).End(xlUp).Row
' Partie 3 : gestion des sauts de page
If Not supprSautPage Then Call GestSautPage
ActiveSheet.PageSetup.PrintArea = "$A$1:F" & Range("E" & Application.Rows.Count).End(xlUp).Row
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
Public Sub GestSautPage()
Dim ligFin As Integer, ligBas As Integer, ligTrav As Integer, colTrav As Integer
Dim Cpb As Range, PBinit As Byte
PBinit = 0
ligFin = ActiveSheet.Range("a1:a500").Find(What:="RepèreduPavéBasdeTotaux", _
After:=Cells(1, 1), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False).Row - 3
ligBas = Range("E" & Application.Rows.Count).End(xlUp).Row
While PBinit <= ActiveSheet.HPageBreaks.Count
i = PBinit + 1
'On Error GoTo sortie
If ActiveSheet.HPageBreaks(i).Extent = xlPageBreakPartial Then
If ActiveSheet.HPageBreaks(i).Location.Row < ligFin Then
ligTrav = ActiveSheet.HPageBreaks(i).Location.Row
Range("A" & ligTrav - 1).EntireRow.Insert (xlShiftDown)
Range("A" & ligTrav).EntireRow.Insert (xlShiftDown)
GoSub lignesST
ligFin = ligFin + 2
PBinit = i
Else
Range("A" & ligFin).EntireRow.Insert (xlShiftDown) 'ok'
Range("A" & ligFin).EntireRow.Insert (xlShiftDown)
ActiveSheet.HPageBreaks.Add Before:=Range("a" & ligFin + 1)
ligTrav = ActiveSheet.HPageBreaks(i).Location.Row
GoSub lignesST
ligFin = ligFin + 2
PBinit = i
Exit Sub
End If
End If
Wend
sortie: Exit Sub
lignesST:
Cells(ligTrav - 1, "C") = "Sous-Total :"
Cells(ligTrav - 1, "D").FormulaR1C1 = "=RC[+2]"
Range("E" & ligTrav - 1 & ":F" & ligTrav - 1).Merge
Cells(ligTrav - 1, "E").FormulaR1C1 = "=SUBTOTAL(9,R2C6:R[-1]C6)"
Cells(ligTrav, "C") = "Report Sous-Total :"
Cells(ligTrav, "D").FormulaR1C1 = "=RC[+2]"
Range("E" & ligTrav & ":F" & ligTrav).Merge
Cells(ligTrav, "E").FormulaR1C1 = "=SUBTOTAL(9,R2C6:R[-2]C6)"
With Range(Cells(ligTrav - 1, "A"), Cells(ligTrav, "C"))
.HorizontalAlignment = xlRight
End With
With Range(Cells(ligTrav - 1, "A"), Cells(ligTrav, "F"))
.Interior.ColorIndex = 20
.Font.Bold = True
End With
With Range(Cells(ligTrav - 1, "A"), Cells(ligTrav - 1, "F"))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 5
End With
End With
With Range("E" & ligTrav - 1 & ":E" & ligTrav)
.NumberFormat = "#,##0.00 $;[Red]-#,##0.00 $;"
End With
Return
End Sub
