imposer nombre de lignes dans un saut de pages | ||
---|---|---|
Inscription: 19/09/2011
Messages:
11
Système d'exploitation: PC Version Excel utilisée: 2007 |
Posté le : 26-08-2014 09h24
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
|
|
|
Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.
Qui consulte actuellement ce sujet ?
1 Utilisateur(s) anonymes