Option Explicit
Private CelDéb As Range, CelCou As Range, CelPgBk As Range, _
NbLMaxParPage, NbLVides As Long, NbColMax As Long, Wsh As Worksheet
Sub InitialiserMiseEnPage(ByVal Cel As Range, ByVal NbLMaxPg As Long, NbLVid As Long)
Rem. ——— Commence un garnissage de feuille à partir de la cellule Cel
' en précisant qu'il ne doit pas y avoir plus de NbLMaxPg lignes dans une page
' et qu'il faut laisser NbLVid lignes devant chaque PlageSuivante.
' Exemple :
' InitialiserMiseEnPage ActiveSheet.Cells(13, "A"), 35, 6
Set CelDéb = Cel: Set CelCou = Cel: Set CelPgBk = Cel
NbLMaxParPage = NbLMaxPg: NbLVides = NbLVid
Set Wsh = Cel.Worksheet
CelDéb.Resize(1000000).EntireRow.Delete
Wsh.ResetAllPageBreaks
End Sub
Function PlageSuivante(TRés(), ByVal LMax As Long) As Range
Rem. ——— Verse LMax lignes du contenu de Trés dans une plage, laquelle est renvoyée
' au programme appelant pour correction des formats et ajout de formules.
' Exemple :
' Dim LaPlage As Range, TR(), L As Long
' Redim TR(1 to 1000, 1 to 11)
' … avec dans des boucles L = L + 1
' … Puis des TR(L, C) = CeQueVousVoulez
' Set LaPlage = PlageSuivante(TR, L)
' LaPlage.Rows(3).Resize(LaPlage.Rows.Count - 2).Borders … etc.
If CelCou.Row + NbLVides + LMax - CelPgBk.Row > NbLMaxParPage Then
Wsh.HPageBreaks.Add Before:=CelCou
Else
Set CelCou = CelCou.Offset(NbLVides)
End If
Set PlageSuivante = CelCou.Resize(LMax, UBound(TRés, 2))
PlageSuivante.Value = TRés
Set CelCou = CelCou.Offset(LMax)
If NbColMax < UBound(TRés, 2) Then NbColMax = UBound(TRés, 2)
End Function
Sub TerminerMiseEnPage()
Rem. ——— Termine le processus.
' Corrige la zone d'impression et ajuste à 1 page en largeur.
Wsh.PageSetup.PrintArea = Range(CelDéb, CelCou.Offset(-1, NbColMax - 1)).Address
Wsh.PageSetup.FitToPagesWide = 1
Set CelDéb = Nothing
Set CelCou = Nothing
Set CelPgBk = Nothing
Set Wsh = Nothing
NbColMax = 0
End Sub
Option Explicit
Private CelDéb As Range, CelCou As Range, CelPgBk As Range, _
NbLMaxParPage, NbLVides As Long, NbColMax As Long, Wsh As Worksheet
Sub InitialiserMiseEnPage(ByVal Cel As Range, ByVal NbLMaxPg As Long, NbLVid As Long)
Rem. ——— Commence un garnissage de feuille à partir de la cellule Cel
' en précisant qu'il ne doit pas y avoir plus de NbLMaxPg lignes dans une page
' et qu'il faut laisser NbLVid lignes devant chaque PlageSuivante.
' Exemple :
InitialiserMiseEnPage ActiveSheet.Cells(13, "A"), 16, 6
Set CelDéb = Cel: Set CelCou = Cel: Set CelPgBk = Cel
NbLMaxParPage = NbLMaxPg: NbLVides = NbLVid
Set Wsh = Cel.Worksheet
CelDéb.Resize(1000000).EntireRow.Delete
Wsh.ResetAllPageBreaks
End Sub
Function PlageSuivante(TRés(), ByVal LMax As Long) As Range
Rem. ——— Verse LMax lignes du contenu de Trés dans une plage, laquelle est renvoyée
' au programme appelant pour correction des formats et ajout de formules.
' Exemple :
' Dim LaPlage As Range, TR(), L As Long
' Redim TR(1 to 1000, 1 to 11)
' … avec dans des boucles L = L + 1
' … Puis des TR(L, C) = CeQueVousVoulez
' Set LaPlage = PlageSuivante(TR, L)
' LaPlage.Rows(3).Resize(LaPlage.Rows.Count - 2).Borders … etc.
If CelCou.Row + NbLVides + LMax - CelPgBk.Row > NbLMaxParPage Then
Wsh.HPageBreaks.Add Before:=CelCou
Else
Set CelCou = CelCou.Offset(NbLVides)
End If
Set PlageSuivante = CelCou.Resize(LMax, UBound(TRés, 2))
PlageSuivante.Value = TRés
Set CelCou = CelCou.Offset(LMax)
If NbColMax < UBound(TRés, 2) Then NbColMax = UBound(TRés, 2)
End Function
Sub TerminerMiseEnPage()
Rem. ——— Termine le processus.
' Corrige la zone d'impression et ajuste à 1 page en largeur.
Wsh.PageSetup.PrintArea = Range(CelDéb, CelCou.Offset(-1, NbColMax - 1)).Address
Wsh.PageSetup.FitToPagesWide = 1
Set CelDéb = Nothing
Set CelCou = Nothing
Set CelPgBk = Nothing
Set Wsh = Nothing
NbColMax = 0
End Sub
Set CelPgBk = CelCou
If Not IsEmpty(TE(LE, 3)) Then TS(LS, 3) = TE(LE, 3) * 100
If Not IsEmpty(TE(LE, 4)) Then TS(LS, 4) = TE(LE, 4)
If Not IsEmpty(TE(LE, 5)) Then TS(LS, 5) = TE(LE, 5)
Next LE