Rapport de message :*
 

imposer nombre de lignes dans un saut de pages

Titre du sujet : imposer nombre de lignes dans un saut de pages
par floka61 le 26/08/2014 09:24:11

Bonjour le forum

 

j'ai un code vba qui fonctionne bien mais seulement pour avoir une bonne disposition lors de l'impression je voudrais réduire le nombre de lignes dans les sauts de pages a 40 ou 35 j'ai essayé plusieurs modifications telle que : 

Range(Cells(Cpb.Row - 1, Cpb.Column), Cells(Cpb.Row + 40, Cpb.Column)).EntireRow.Insert (xlShiftDown)

j'ai voulu aussi créer une variable de cette façon :

dim h as integer  'hauteur de saut de page
h=40

mais j'ai pas su ou la mettre dans le présent code :

Sub InserST()
Dim pb As Object
Dim C As Range
Dim i As Byte, j As Byte, k As Byte
Dim ReportSTe As Double, ReportSTf As Doubl
Dim h As Integer
'Dim Last As Integer
ActiveWindow.View = xlPageBreakPreview
'***********************************Partie 1 : Suppression des sous-totaux*******************************************************************************
With ActiveSheet.Range("D16:D" & Range("D" & Application.Rows.Count).End(xlUp).Row)
    Do
        Set C = .Find("Total")
        If Not C Is Nothing Then
            Cells(C.Row, "D").EntireRow.Delete
        End If
    Loop While Not C Is Nothing
End With
 
'***********************************Partie 2 : Définition auto de la zone d'impression*******************************************************************
 
ActiveSheet.PageSetup.PrintArea = "$D$1:" & Range("I" & Application.Rows.Count).End(xlUp).Address
 
'***********************************Partie 3 : gestion des sauts de page*********************************************************************************
i = 0
j = 0
For Each pb In ActiveSheet.HPageBreaks
    i = i + 1 '***incrémente le n°de saut de page général(Permet de gérer le cas de sauts de pages externes à la zone d'impression)
    If pb.Extent = xlPageBreakPartial Then
        j = j + 1  '***incrémente le n°de saut de page de la zone d'impression
        Set Cpb = ActiveSheet.HPageBreaks(i).Location
        If Cpb.Value <> "Report Sous-Total" Then
            Range(Cells(Cpb.Row - 1, Cpb.Column), Cells(Cpb.Row, Cpb.Column)).EntireRow.Insert (xlShiftDown)
            Cells(Cpb.Row - 3, Cpb.Column) = "Sous-Total"
                If j = 1 Then
                    Cells(Cpb.Row - 3, "I").Formula = "=SUM(I16:I" & Cpb.Row - 4 & ")"
 
                        With Range(Cells(Cpb.Row - 3, "D"), Cells(Cpb.Row - 2, "I"))
                            .Interior.ColorIndex = 40
                            .Font.Bold = True
                        End With
                Else
                    k = WorksheetFunction.Max(9, ActiveSheet.HPageBreaks(i - 1).Location.Row)
                    Cells(Cpb.Row - 3, "I").Formula = "=SUM(I" & k & ":I" & Cpb.Row - 4 & ")"
 
                        With Range(Cells(Cpb.Row - 3, "D"), Cells(Cpb.Row - 2, "I"))
                            .Interior.ColorIndex = 40
                            .Font.Bold = True
                        End With
                End If
            Cells(Cpb.Row - 2, Cpb.Column) = "Report Sous-Total"
            Cells(Cpb.Row - 2, "I") = Cells(Cpb.Row - 3, "I")
 
        End If
    End If
Next
 
'******************************************Partie 4 : Affichage du total bas de page *****************************************************************************************
 
Last = Range("D" & Application.Rows.Count).End(xlUp).Row
    If Cells(Last, "D") <> "Total Général" Then
        Cells(Last, "D").EntireRow.Insert (xlShiftDown) '**Permet d'étendre la zone d'impression
        Range(Cells(Last + 1, "D"), Cells(Last + 1, "I")).Copy (Cells(Last, "D"))
        Cells(Last + 1, "D").EntireRow.ClearContents
        Cells(Last + 1, "D") = "Total Général"
        ActiveSheet.Cells(Last + 1, "I") = "=SUM(I" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":I" & Last & ")+I5"
        'Cells(Last + 1, "F") = "=SUM(F" & WorksheetFunction.Max(9, Cpb.Row - 2) & ":F" & Last & ")+F5"
 
        With Range(Cells(Last + 1, "D"), Cells(Last + 1, "I"))
            .Interior.ColorIndex = 45
            .Font.Bold = True
        End With
    End If
    ActiveWindow.View = xlNormalView
     'miseEnPageAvantImpression
     'Ajuster
     Application.Dialogs(xlDialogPrint).Show
End Sub

merci d'avance de votre aide et bonne journée