XL 2016 Passer à la page suivante automatiquement

bennp

XLDnaute Occasionnel
Bonjour,

j'ai un tableau créé en macro, et parfois il se retrouve à la jonction de 2 pages. Quelqu'un aurait une idée pour déplacer automatiquement le tableau à la page suivante ?

Merci
 

bennp

XLDnaute Occasionnel
Bonjour,
voici le fichier excel en question, tu dois le connaître :)
On aurait pu penser en terme de numéro de ligne vide ou non mais comme mes tableaux ont des hauteurs variables et que chaque tableau a une entête de hauteur 30, ça me parait complique de dire que c'est entre la ligne 40 et 41 qu'il y a un saut de page par exemple. Du coup je ne vois pas trop comment faire..

Merci pour l'aide svp
 

Fichiers joints

bennp

XLDnaute Occasionnel
Pour être sûr ; je voudrais que le tableau ayant comme titre SIMON ne soit pas coupé en 2, j'aimerais qu'il soit à la page suivante.
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Ajoutez quelque part une instruction :
VB:
ActiveSheet.HPageBreaks.Add Before:=ActiveCell
soumise à un If Then détectant que la tableau ne tiendra pas sur la page en cours.
 

bennp

XLDnaute Occasionnel
merci pour le code, par contre je suis incapable de le mettre dans le code, surtout avec un If Then, un petit coup de pouce s'il vous plait ?

merci
 

Dranreb

XLDnaute Barbatruc
Pas envie de plonger dans votre code.
Mais le principe c'est de noter dans une variable le numéro de ligne au début d'une page (donc aussi juste après l'instruction indiquée). Lorsque vous envisagez de verser un tableau à partir d'une ligne contenue dans une autre variable vérifiez si cette ligne augmentée du nombre de ligne du tableau à ajouter et diminué de la dernière ligne de début de page notée ne dépasse pas le nombre de lignes d'une page.
 

bennp

XLDnaute Occasionnel
Je pense pas que ça puisse fonctionner (si j'ai bien compris..). je demande une hauteur de 30 pour l’entête de chaque tableaux que je crée, il peut y avoir entre 2 ou 10 tableaux rien que sur la première page, donc le nombre de lignes d'une page peux varier. J'ai testé quelquechose, évidemment ça fonctionne pas (je suis une bille en vba), mais bon ça peut peut-être donner une idée :

VB:
Sub saut_de_page()

    If Rows("39:40") <> "" Then
        If Rows("38:39") <> "" Then
            If Rows("38:39") <> "" Then
                If Rows("37:38") <> "" Then
                    If Rows("36:37") <> "" Then
                        If Rows("35:36") <> "" Then
                        Else
                            Rows("35:36").Select
                            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
                        End If
                    End If
                End If
            End If
        End If
    End If
   
End Sub
je pense qu'on peut insérer des variables la dedans et ça bug car il attend quelque chose après chaque then...
le but est que mes fin de pages se situeront à peu près à ce niveau là, et si j'ai au moins 2 lignes vides en remontant vers le haut, ça veut dire que je suis plus dans un tableau et donc on peut insérer un saut de page.

Le problème qui va se poser est que si par exemple mes lignes 39 et 40 sont vides, ça va me faire un saut de page alors que je n'en veut pas...

Merci de votre aide svp
 

Dranreb

XLDnaute Barbatruc
Je voulais parler du nombre de ligne maxi, au delà duquel il y a saut de page automatique.
Commencez par déclarer vos constantes et variables
Const NbrLMaxi = 25: Dim NbrL As Long, LDébPg As Long, LCou as Long

de manière à pouvoir faire
VB:
If LCou + NbrL - LDépPg > NbrLMaxi Then
   ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
   LDébPg = LCou: End IF
LCou = LCou + NbrL
NbrL étant bien sûr le nombre de lignes de la plage à copier, soit LaDitePlage.Rows.Count
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Non, le nombre maxi de ligne imprimable dans une page sans que ça fasse venir un saut de page automatique. À déterminer expérimentalement.
 

Dranreb

XLDnaute Barbatruc
Vous n'avez peut être pas besoin de LDépPg: vous pouvez aussi accumuler le nombre total de lignes garnies, et si vous voyez qu'avec le nombre de lignes de la prochaine plage à copier ça va dépasser ce qui tient dans une page vous mettez le HPageBreak puis vous remettez ce total de lignes à 0.
 

bennp

XLDnaute Occasionnel
j'ai réussi à trouver le nombre de ligne de mon tableau :
Rows(x + 1 & ":" & fin + 1).Select
avec x = Cells(Rows.Count, q).End(xlUp).Row

fin est défini en amont donc pas besoin de le définir à mon avis... --> (fin = Selection.Row + 1)

Par contre pour avoir le nombre le ligne disponible sur ma page, je ne trouve pas de code...

Je dois l'insérer quelque part la dedans mais où ?

VB:
NomsColonnes = Array("Fruit", "", "", "", "épaisseur", "", "", "chiffre", "", "", "clé")
    For Each Nom In MonDico.keys 'pour chaque nom contenu dans le dictionnaire
        If IsEmpty(fin) Then
            fin = Selection.Row + 1
            Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select '(fin + 3 --> écart 1 ligne entre dupont et tableau
            Call entete
            Call Cadrage
            Selection.WrapText = True
        Else
            fin = Sheets("Feuil2").Cells(Rows.Count, Selection.Column).End(xlUp).Row + 5 '+5 --> écart entre chaque tableau
            Range(Cells(fin + 3, q), Cells(fin + 3, q + UBound(NomsColonnes))).Select '(fin + 3 --> écart 1 ligne entre dupont et tableau
            Call entete
            Call Cadrage
            Selection.WrapText = True
        End If
        Cells(fin + 1, Selection.Column) = UCase(Nom)
        Rows(fin + 3).RowHeight = 30 '(fin + 3 --> écart 1 ligne entre dupont et tableau
        Cells(fin + 1, Selection.Column).Font.Bold = True
        i = 1
        For Each intitulé In NomsColonnes
            Sheets("Feuil2").Cells(fin + 1, Selection.Column).Offset(2, i - 1) = intitulé '(fin + 1 --> écart 1 ligne entre dupont et tableau
            i = i + 1 ''
        Next intitulé
        For i = LBound(tablo, 1) To UBound(tablo, 1) 'pour chaque ligne du tablo
            If UCase(tablo(i, col)) = UCase(Nom) Then 'si on est sur le bon nom
                For j = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'pour chaque colonne
                    If tablo(i, j) <> "" Then 's'il y a quelque chose
                        For Each intitulé In NomsColonnes
                            If tablo(1, j) = intitulé Then
                               
                                    If intitulé = "épaisseur" Then
                                        k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
                                        Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = (tablo(i, j) * 100)
                                    Else
                                        k = Application.WorksheetFunction.Match(intitulé, NomsColonnes, 0) + Selection.Column - 1
                                        Cells(Rows.Count, k).End(xlUp).Offset(1, 0) = tablo(i, j)
                                    End If
                               
                            End If
                        Next intitulé
                    End If
                Next j
            End If
        Next i
Merci encore pour le temps passé !
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Il n'y a rien que je sache qui indique combien de lignes il tient sur une page. D'ailleurs ça dépend d'un tas de choses. C'est à vous de le fixer arbitrairement et de compter vous même dans des variables à vous combien de lignes vous allez renseigner depuis le début ou le dernier mis pour savoir s'il y a lieu d'ajouter un HPageBreak pour éviter que ce paquet soit coupé par un saut de page automatique si la fin dépasse.
 

Dranreb

XLDnaute Barbatruc
Essayez d'utiliser ces procédures, écrites dans un module séparé :
VB:
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
À tester…
 

Dranreb

XLDnaute Barbatruc
Je vous avais dit d'utiliser ces procédures, écrites dans un module séparé.
En aucun cas dans une procédure.
l'instruction Option Explicit est en général la 1ère instruction d'un module.
Ensuite viennent les déclarations globales, Private et Public.
 

Discussions similaires


Haut Bas