Excel VBA saut de Page

Alors désolé, je ne peux pas vous dépanner.

Pas de soucis! Merci d’avoir essayé, j’ai essayé un bout de code qui pouvait fonctionner, mais j’ai rencontré un soucis, je posterai sûrement mon problème demain !

Si cela peut vous dépanner, envoyez-moi votre fichier à l'adresse que je vous envoie en message privé pour que j'y jette un oeil.

Re bonjour à toutes et à tous !

Afin de résoudre le problème de mon code saut de page, quelqu'un peut m'aider pour le cas suivant :
Dans mon For & Each, j'aimerai qu'après avoir trouvé 2 ou 3 résultats, la fonction FOR s'arrête avec un Exit FOR ?

Car dans mon cas l'Exit FOR se lance dès le 1er résultat, et étant donné que j'ai un Array couplé au code j'aimerai garder plusieurs potentiels résultats :) !

Malheureusement, j'ai oublié de m'envoyer le code...

Bonjour,

Donc j'aimerai qu'après 3 valeurs trouvées que la macro sorte de la boucle et qu'ensuite je puisse utiliser les 3 valeurs stockées dans des arrays voir le code ci-dessous, comme ça je pourrai utiliser différents sauts de page !

 Dim myArray_2() As Variant

Dim Blank_c_range_2 As Range
Dim cel_2 As Range
Dim y As Long

'Determine the data you want stored

  Set Blank_c_range_2 = Worksheets(1).Range("D100:D180")

'Loop through each cell in Range and store value in Array

  For Each cel_2 In Blank_c_range_2

    ReDim Preserve myArray_2(y)

      If Trim(cel_2.Value) = "" And Right(cel_2.Address, 3) > "100" And Right(cel_2.Address, 3) < "180" And cel_2.Offset(-1, 0).Value <> "" And cel_2.Interior.ColorIndex <> cel_2.Offset(-1, 0).Interior.ColorIndex And Right(hPB_2.Location.Address, 3) > Right(cel_2.Address, 3) Then

       myArray_2(y) = cel_2.Row

    y = y + 1

      MsgBox ("IF 2 - Break second Page according to conditions " & myArray_2(0))

   Worksheets(1).Rows(myArray_2(0)).PageBreak = xlPageBreakManual

End If

Next cel_2

D'avance merci pour vos retours.

Bonjour,

Que représente hPB_2 ?

A défaut :

Dim MyArray_2() As Variant
Dim Blank_c_range_2 As Range
Dim cel_2 As Range
Dim y As Long

'Determine the data you want stored

  Set Blank_c_range_2 = Worksheets(1).Range("D100:D180")

  'Loop through each cell in Range and store value in Array
  y = 0
  For Each cel_2 In Blank_c_range_2

      If Trim(cel_2.Value) = "" And cel_2.Offset(-1, 0).Value <> "" _
         And cel_2.Interior.ColorIndex <> cel_2.Offset(-1, 0).Interior.ColorIndex _
         And Right(hPB_2.Location.Address, 3) > Right(cel_2.Address, 3) Then

             ReDim Preserve MyArray_2(y)
             MyArray_2(y) = cel_2.Row
           '  MsgBox ("IF 2 - Break second Page according to conditions " & MyArray_2(y))
             y = y + 1

      End If

      If y = 2 Then Exit For

   Next cel_2

   For y = LBound(MyArray_2) To UBound(MyArray_2)
       If MyArray_2(y) > 0 Then
          Worksheets(1).Rows(MyArray_2(y)).PageBreak = xlPageBreakManual
       End If
   Next I

Bonjour à tous,

je reviens un peu en arrière sur le dernier fichier d'eric ici : https://forum.excel-pratique.com/s/goto/1035171

Je n'arrivais pas à comprendre pourquoi son code qui parait correct plantait sur ton fichier et supposais qu'il pouvait être vérolé.
Il n'est pas entré dans le détail mais VBA annonce 5 sauts de pages et seul le premier est accessible. Comme la suppression commence par la fin => plantage.

Il semble que ce soit plus dû à un bug.
Si on scrolle, plus de .HPageBreaks(I) deviennent accessibles.
Scroller sur la dernière avec l'ajout de cette ligne de code semble lui remettre les idées en place :

    With Sh
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Application.Goto (Cells(DerniereLigne, 1)), True

J'obtiens bien les 14 pages des 14 blocs.
eric

Bravo Eriiic,

J'étais prêt à reprendre mon code comme dans la ligne ci-dessous indiquée dans mon précédent message qui fonctionne correctement une fois chargée la variable tableau.

Worksheets(1).Rows(MyArray_2(y)).PageBreak = xlPageBreakManual

Bonjour Eriiic & Eric,

Pouvez-vous me mettre le code en entier avec le GOTO ?

Pouvez-vous aussi mettre un msgbox au bon endroit pour que je puisse voir les adresses de tous les sauts de pages ?

Car je pense que je prends pas correctement les codes...

Je dois encore essayer la suggestion du Exit for faites par Eric,

En tout cas je vous remercie déjà pour votre grand investissement !

Vincent

Il faut enlever l'apostrophe devant le Msgbox.

Re,

Je suis désolé mais je suis perdu, peux-tu m'envoyer le code complet qu'Eriiic a completé stp ?

Car j'ai que des erreurs...D'avance merci, Vincent.

Ci-joint la version avec la modification proposée par Eriiic :

Re,

désolé, j'étais absent...
Je crois que tu t'es fait des noeuds dans les versions de fichier eric K, je n'y vois pas ce que j'avais proposé.
Le palliatif suggéré pour le bug :

Sub GenererDesSautDePage(ByVal Sh As Worksheet)
    Dim I As Long, DerniereLigne As Long
    With Sh
        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Application.Goto (Cells(DerniereLigne, 1)), True 'scroller jusqu'à la dernière ligne
        If .HPageBreaks.Count > 0 Then
            For I = .HPageBreaks.Count To 1 Step -1
                .HPageBreaks(I).Delete
            Next I
        End If
        For I = DerniereLigne To 4 Step -1
            If .Cells(I, 1) = "Saut" Then
                .HPageBreaks.Add Before:=.Cells(I, 1)
            End If
        Next I
    End With
End Sub

eric

Edit : j'avais bien évoqué un Exit For à moment donné, mais un doute me l'a fait enlever. Tu as été trop rapide à lire ;-)
Je pense qu'il faut finir la boucle pour enlever tous les sauts manuels si un jour la taille de tes blocs change.

Pour répondre à Eric, le dernier fichier transmis correspond à ma version du 25 dans laquelle j'ai ajouté ta ligne de code.

re à tous,

ça a l'air de fonctionner cependant j'aimerais que s'il y a assez de place sur une page que ça prenne éventuellement 2-3 blocs et que les blocs vides n'apparaissent pas pour effectuer mon export PDF avec que des données.

Je me suis peut-être mal exprimé désolé.

Merci encore Vincent.

Je te laisse finir eric, comme je n'ai pas tout suivi en détail.
C'est juste cette bizarrerie qui me tracassait.
eric

PS : je viens de voir que j'avais 2 versions d'ouvertes, je n'ai pas dû regarder la bonne tout à l'heure

Il va falloir vous accrocher :

• Créer un onglet : BLOCS et un tableau structuré : TableDesImpressions.
• C4 correspond à la zone nommée NbCellulesVides. C'est la valeur repère pour décider qu'un bloc est à imprimer
• C5 correspond à la zone NbLignesParPage. C'est la valeur limite de lignes à imprimer par page.
• C6 correspond à MaxImpression. C'est la dernière ligne qui sera imprimée. La valeur est mise à jour par la procédure GererLesSautsDePage

Dans l'onglet EXEMPLE : Créer les 14 zones nommées (Bloc01 à Bloc14) pour le calcul des cellules vides.

Option Explicit

Sub GererLesSautsDePage(ByVal ShImp As Worksheet, ByVal LigneDeTitre As Integer)

Dim I As Integer, J As Integer, NbLignesMax As Integer, LigneEnCours As Integer, LigneDebut As Integer, DerniereLigne As Integer
Dim AireSautsDePage As Range, AireNbLignes As Range, AireAImprimer As Range

   Set AireSautsDePage = Range("TableDesImpressions[Sauts de page]")
   Set AireNbLignes = Range("TableDesImpressions[Nb lignes]")
   Set AireAImprimer = Range("TableDesImpressions[A imprimer]")
   NbLignesMax = Range("NbLignesParPage")
   LigneEnCours = 0
   LigneDebut = 0

   AireSautsDePage.ClearContents
   For I = 1 To AireSautsDePage.Count
       With AireSautsDePage(I)
            LigneEnCours = LigneEnCours + AireNbLignes(I)
            If LigneEnCours > NbLignesMax + LigneDebut Then
               AireSautsDePage(I) = LigneEnCours - AireNbLignes(I) + LigneDeTitre + 1
               LigneDebut = LigneEnCours - AireNbLignes(I)
            End If
       End With
   Next I

   With ShImp

        .Activate

        Application.PrintCommunication = False
        .PageSetup.PrintArea = ""
        Application.PrintCommunication = True

        DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
        Application.Goto (.Cells(DerniereLigne, 1)), True

        For J = DerniereLigne To 4 Step -1
            For I = 1 To AireSautsDePage.Count
                If AireSautsDePage(I).Value = J + 1 Then
                   .HPageBreaks.Add Before:=.Cells(J + 1, 1)
                   Exit For
                End If
            Next I
        Next J

       ' Recherche de la dernière ligne à imprimer
        For I = AireSautsDePage.Count To 1 Step -1
            If AireSautsDePage(I) > 0 And AireAImprimer(I) = "Non" Then
                   DerniereLigne = AireSautsDePage(I) - 1
                   Range("MaxImpression") = DerniereLigne
                End If
            Next I

        Application.PrintCommunication = False
        With .PageSetup
             .PrintTitleRows = "$1:$" & LigneDeTitre
             .PrintArea = "$1:$" & DerniereLigne
        End With
        Application.PrintCommunication = True

        .Cells(LigneDeTitre + 1, 1).Select

    End With

    Set AireSautsDePage = Nothing: Set AireNbLignes = Nothing:  Set AireAImprimer = Nothing

End Sub

Dans le module de l'onglet "Blocs"

Option Explicit

Private Sub BoutonSautsDePage_Click()

        SupprimerLesSautsDePage Sheets("EXEMPLE")
        GererLesSautsDePage Sheets("EXEMPLE"), 4

End Sub

Bonjour,

Merci déjà pour l'énorme effort donné !

Pouvez-vous nous donner le fameux fichier exemple svp ?

Vincent