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
|
Forums