Saut de page en VBA

Bonjour à tous,

voici mon probleme

Je souhaite faire des sauts de page sur des blocs (de la celulle A1:A5 = ROU; de A6:A9 = BLR; de A10:A26 = BLC...) de façon que mes blocs soit entier sur la page mais que le saut de page n'intervienne que lorsque la feuille est arrivé a la fin. Le tout en VBA pour une macro.

J’espère que mes explication sont claires. Merci d'avance a tous pour votre aide.

Bonjour,

ceci devrait fonctionner

Sub Macro1()
'
Dim NBLIGNES As Long
Dim NBSAUTS As Long
Dim VALSAUTS As Long
NBLIGNES = Range("A65536").End(xlUp).Row ' on trouve le nombre de ligne total de votre feuille
NBSAUTS = NBLIGNES / 5  ' on calcul le nombre de sauts de pages nécessaires
VALSAUTS = 5   ' valeur du saut de page

'ON BOUCLE AUTANT DE FOIS QUE DE SAUTS TROUVES PRECEDEMMENT
For I = 1 To NBSAUTS
    Rows(VALSAUTS + 1 & ":" & VALSAUTS + 1).Select
    ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell

'ON INDIQUE LA NOUVELLE VALEUR DU PROCHAIN SAUT AVANT LA BOUCLE SUIVANTE
VALSAUTS = VALSAUTS + 5

Next I

End Sub
3test-sauts.xlsm (16.63 Ko)

Oops pas sur la réponse vu la fin de la demande ? Si le saut n'est pas tous les 5 mais uniquement en fin de pages

il va falloir un modèle de votre fichier afin de calculer le nombre de lignes avant un saut

Bonjour,

ne serait-ce pas plus compliqué ? Moi j'ai compris que les blocs de 5 lignes étaient non sécable, mais qu'il pouvait y en avoir plusieurs sur une feuille et que le saut de page n'intervienne donc pas au beau milieu d'un bloc...

Sans fichier tout est sujet à interprétation !

@ bientôt

LouReeD

Bonjour, LouReed je viens de modifier mon post effectivement j'ai loupé le "à chaque fin de page"

Du coup sans modèle impossible de calculer ou sont les sauts .

Effectivement un petit fichier pour simplifier les choses

Bonsoir Micka, Xmenpl, LouReed,

Voici une tentative avec le code suivant :

Sub test()

Dim ws As Worksheet: Set ws = ActiveSheet

With ws
    .ResetAllPageBreaks
    dl = .Cells(.Rows.Count, 2).End(xlUp).Row
    For i = 2 To dl
        prec = Split(.Cells(i - 1, 2).Value, ":")
        cours = Split(.Cells(i, 2).Value, ":")
        If .Cells(i, 2) Like "*:*" Then
            Select Case True
                Case Not .Cells(i - 1, 2) Like "*:*": cond = True
                Case prec(1) <> cours(1): cond = True
                Case Else: cond = False
            End Select
            If cond Then .HPageBreaks.Add before:=.Rows(i)
        End If
    Next i
    While .VPageBreaks.Count > 0
        .VPageBreaks(1).DragOff xlToRight, 1
    Wend
    .VPageBreaks.Add before:=.Columns(4)
End With

End Sub

Je pense que c'est pas mal mais ce n'est pas évident d'en être certain vu qu'il y a quelques irrégularités dans votre modèle. A vous de me dire...

Cdlt,

Bonjour,

merci pour toutes vos réponse j'ai oublier un point important cela ne s'applique que a la colonne B les blocs doivent être entier et la feuille complète sachant que c du format A3 en portrait merci a vous et vraiment désolé de l'oubli des détails. Ci joint le résultat que cela doit donner (pour l'exemple cela a etait fait manuellement). La premiere feuille est pleine elle n'a pas assé pour mettre "BLF" en entier donc passage sur la feuille suivante et ainsi de suite.

Merci a tous pour votre aide j'espere que ces explications vous permettrons de m'aider.

Micka17

Bonjour,

C'est ça le résultat que vous attendez ? Et bien, c'est très bien, manuellement ça fonctionne bien !

Surtout, je ne vois pas ce qui permet d'arbitrer sur l'insertion d'un saut de page ou non ? On doit mettre un saut de page avant que la page ne fasse 60 lignes c'est ça ?

Cdlt,

Bonsoir,

L'idée :

Mettre les sauts de page en "automatique"

Du coup mauvais découpage possible.

Scan des sauts de page de haut en bas, vérification qu'il ne se trouve pas au milieu d'un bloc.

Si c'est le cas on le "remonte" au début du bloc. On passe au saut suivant.

Si ce n'est pas les cas on passe au saut suivant.

Et on répète...

@ bientôt

LouReeD

Salut LouReed,

Merci pour cette clarification ! Voici donc un nouvel essai où l'on insère un saut de page, quand c'est possible 60 lignes après le précédent, sinon à la fin du bloc précédent :

Sub test()

Dim blocs()

With ActiveSheet
    .ResetAllPageBreaks
    dl = .Cells(.Rows.Count, 2).End(xlUp).Row
    cpt = 1: ReDim blocs(0): blocs(0) = 1
    For i = 2 To dl
        cpt = cpt + 1
        If .Cells(i, 2) Like "*:*" And .Cells(i - 1, 2) Like "*:*" Then
            prec = Split(.Cells(i - 1, 2).Value, ":")
            cours = Split(.Cells(i, 2).Value, ":")
            If prec(1) <> cours(1) Then
                n = n + 1
                ReDim Preserve blocs(n)
                blocs(n) = i
            End If
            If cpt = 61 Then
                .HPageBreaks.Add before:=.Rows(blocs(n))
                cpt = 1
            ElseIf cpt > 61 Then
                .HPageBreaks.Add before:=.Rows(blocs(n - 1))
                cpt = 1
            End If
        End If
    Next i
    While .VPageBreaks.Count > 0
        .VPageBreaks(1).DragOff xlToRight, 1
    Wend
End With

End Sub

Cdlt,

Le 61 n'est valable que si les hauteurs de lignes ne changent pas, mais c'est certainement le cas, à moins également qu'on décide par manque de papier de passer sur du A4 en paysage...

@ bientôt

LouReeD

Euh, je pense que c'est déjà pas mal, Mr l'inspecteur des travaux finis , en l'absence de réponse de Micka...

Il y a toujours possibilité d'agir en fonction de la hauteur des lignes, ...

Mais compte tenu du besoin, sachant que la manipulation de sauts de page n'est pas la chose la plus évidente, si on gère tous les risques, on s'en sort plus. Le principal risque ici est qu'il y ait un gros bloc et qu'on ne puisse pas insérer de saut de page. Le cas échéant, on arrangera...

Cdlt,

Heureusement que je suis bien constitué pour encaisser une remarque comme celle-ci !

Inspecteur des travaux finis ! Si seulement... Moi un pauvre manœuvre...

@ bientôt

LouReeD

Je te rassure, il n'y a aucune méchanceté ni animosité dans cette remarque ! Mais, venant de poser un second code en remplacement d'un premier, alors même que le besoin n'a pas encore été parfaitement défini, j'espère que tu comprends que je prenne les mises en exergue des petites "imperfections" de mon code comme du pinaillage . Et à mon avis, faire une proposition de code apporte toujours plus que commenter celui des autres.

Donc si tu te sens l'envie d'y apporter des modifications, je t'en prie, je ne le prendrai absolument pas mal ! Au contraire, si je peux apprendre !

Cdlt,

Non pas de modifications, et j'ai pris les remarques dans le bon sens, je suis !

Voici ma proposition :

Sub SautDePageLRD()
    Dim NbLigne, I
    NbLigne = Range("A" & Rows.Count).End(xlUp).Row + 1
    For I = 1 To NbLigne
        If Rows(I).PageBreak <> xlNone Then
            Do
                If Cells(I - 1, 1) = Cells(I, 1) Then
                    I = I - 1
                Else
                    Exit Do
                End If
            Loop
            Rows(I).PageBreak = xlPageBreakManual
        End If
    Next I
End Sub

En fait au départ, la feuille est sans saut de page, seuls les pointillés de découpage automatique d'impression sont visible suite à une visu avant impression.
La boucle VBA va détecter ces découpages automatiques, les uns après les autres.
S'il y en a un, on vérifie qu'il ne se trouve pas dans un bloc.
S'il est dans un bloc, alors on remonte d'une ligne et ce jusqu'à sortir du bloc.
A ce moment là uniquement on insert un saut de page Manuel.
De ce fait, le découpage automatique va se "recalculer".
La boucle continue leur recherche et continue leur déplacement en créant un saut de page manuel.
Au final le tableau est découpé par feuille sans découper les blocs, sans connaître à l'avance le nombre de ligne à afficher du fait que la hauteur de chacune est différente.

Le fichier :

Seul le cas d'un bloc plus grand qu'une feuille n'est pas prise en compte. Pour cela il faudrait faire un test sur le fait que lors d'une "remonté" de ligne on ne dépasse pas la valeur de la précédente.

@ bientôt

LouReeD

Nickel alors !

C'est une bonne idée et cette proposition a le mérite d'être plus courte et aérée que la mienne .

Oui, je pense qu'il vaut mieux attendre le retour de Micka avant de faire plus "mieux que bien".

A bientôt,

Cdlt,

Bonjour,

Plus condensé :

Sub SautDePageLRD()
    Dim I
    For I = 1 To Range("A" & Rows.Count).End(xlUp).Row + 1
        If Rows(I).PageBreak <> xlNone Then
            Do
                If Cells(I - 1, 1) = Cells(I, 1) Then I = I - 1 Else Exit Do
            Loop
            Rows(I).PageBreak = xlPageBreakManual
        End If
    Next I
End Sub

@ bientôt

LouReeD

Bonjour à tous,

pour déterminer un bloc, il ne faut pas prendre que la partie gauche de B sans Raie:x ?
eric

Bonjour,

Mon code n'est qu'un principe est non pas la solution au sujet précis.

Le test pour les blocs est en effet à adapter.

@ bientôt

LouReeD

Bonjour a tous

LouReeD le résultat et intéressant ce qui me manque c'est que les feuilles ne sont pas rempli complètement tant qu'il y a de la place sur la page il faut qu'elle soit rempli et quand on arrive a la fin de la page si, par exemple, le bloc rouge ne rentre pas entièrement on le bascule sur la page deux et ainsi de suite.

Un grand merci a tous pour les solutions proposées.

Micka17

Rechercher des sujets similaires à "saut page vba"