Discussion :

[mercatog]

Oui effectivement tu as raison Dominique.

[Invité]

Bonjour Mercatog, Casefayere, Clementmarcotte, le forum,

Rien à redire, ça confirme ce que je pense Mercatog tu es un AS. Casefayere ne démérite pas non plus.

Quant à Clementmarcotte, il a le mérite de m'avoir incité à orienter mes recherches ailleurs que sur Developpez.com.

Et je dois dire que mes récentes recherches ont été payantes. je n'ai effectué que quelques modifications.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub SautDePage()
'saut de page par rapport à des cellules fusionnées
Dim DerLig, Lig
 
ActiveSheet.PageSetup.PrintTitleRows = "$2:$4" 'entete tableau
ActiveSheet.ResetAllPageBreaks ' raz saut
 
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
 
    For Lig = 4 To DerLig
        Cells(Lig + 1, "B").Select
        If Selection.Count > 1 Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(Lig + Selection.Count + 1, "A")
            Lig = Lig + Selection.Count - 1
        End If
    Next Lig
End Sub

Je vous remercie tous autant que vous êtes. Toute ma gratitude.

Cordialement,

Cat

[casefayere]

Tu fais comme tu le sens, mais je changerais cette portion de code afin d'éviter les "Select" qui sont inutiles

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Lig = 4 To DerLig
        Cells(Lig + 1, "B").Select
        If Selection.Count > 1 Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(Lig + Selection.Count + 1, "A")
            Lig = Lig + Selection.Count - 1
        End If
    Next Lig

pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Lig = 4 To DerLig
        'Cells(Lig + 1, "B").Select
        If Cells(Lig + 1, "B").Count > 1 Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(Lig + Cells(Lig + 1, "B").Count + 1, "A")
            Lig = Lig + Cells(Lig + 1, "B").Count - 1
        End If
    Next Lig

[Invité]

Casefayere 1000 mercis, c'est très gentil de ta part de m'avoir corrigé.

Bonne continuation. Et dire que j'avais reçu un avertissement concernant cette discussion.

Merci à tous.

Cordialement,

Cat

[mercatog]

J'ajoute que les abc des boucles For/Next, ne pas toucher au compteur à l'intérieur, en l’occurrence la variable Lig

En plus, c'est suffisant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.HPageBreaks.Add Before:=.....

[Invité]

Mon cher Mercatog,

Ta réputation et tes compétences ne sont plus à démontrer. Je te confie que j'ai déjà inséré ton code dans mon fichier.

Je te remercie beaucoup mais je n'ai pas bien compris ton dernier message. Et par conséquent, je ne sais pas ce que je dois corriger
pour respecter les règles des boucles For/Next que je ne connais pas sur le bout des doigts.

Merci beaucoup.

Cordialement,

Cat

[Invité]

Tu fais comme tu le sens, mais je changerais cette portion de code afin d'éviter les "Select" qui sont inutiles

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Lig = 4 To DerLig
        Cells(Lig + 1, "B").Select
        If Selection.Count > 1 Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(Lig + Selection.Count + 1, "A")
            Lig = Lig + Selection.Count - 1
        End If
    Next Lig

pour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
For Lig = 4 To DerLig
        'Cells(Lig + 1, "B").Select
        If Cells(Lig + 1, "B").Count > 1 Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(Lig + Cells(Lig + 1, "B").Count + 1, "A")
            Lig = Lig + Cells(Lig + 1, "B").Count - 1
        End If
    Next Lig

J'ai suivi ton conseil, mais le code ne fonctionne pas. j'ai donc gardé le "select"

cordialement,

[Invité]

J'ajoute que les abc des boucles For/Next, ne pas toucher au compteur à l'intérieur, en l’occurrence la variable Lig

En plus, c'est suffisant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.HPageBreaks.Add Before:=.....

Option Explicit

Sub SautDePage()
'saut de page par rapport à des cellules fusionnées
Dim DerLig, Lig
ActiveSheet.ResetAllPageBreaks ' raz
DerLig = Range("B" & Rows.Count).End(xlUp).Row
For Lig = 4 To DerLig
Cells(Lig + 1, "B").Select
If Selection.Count > 1 Then
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(Lig + Selection.Count + 1, "A")
' Lig = Lig + Selection.Count - 1 '**
End If
Next Lig
End Sub

Si j'ai bien compris pour la boucle (à l'intérieur d'une boucle For/Next), mais ça ne fonctionne pas parfaitement, juste après le 1er groupe de cellules fusionnées sont insérés des sauts de page au sein du 2ème groupe de cellules fusionnées et ainsi de suite.

j'ai executé au pas à pas, j'ai constaté que le curseur sauter Lig=Lig+selection.count-1 et en la supprimant le résultat est mauvais.

Merci.

Cordialement,

[casefayere]

chez moi mon code fonctionne mais de toutes façon le code à mercatog est meilleur, il suffit d'ajouter mon code qui retire la fusion au départ afin de ne pas avoir de problème du style "impossible de modifier une cellule fusionnée et plutôt que de te référer à ActiveSheet, prends le nom de la feuille, je remets ci-dessous les codes basés sur le fichier exemple que tu as communiqué, contentes-toi de copier/coller ces codes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Fusion()
Dim LastLig As Long, i As Long
Application.ScreenUpdating = False
nonFusion
With Worksheets("Feuil1")
  .PageSetup.PrintTitleRows = "$2:$4" 'entete tableau
  .ResetAllPageBreaks ' raz saut
  LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row
  For i = LastLig To 5 Step -1
    If .Range("B" & i) = .Range("B" & i - 1) Then
      .Range("B" & i - 1).ClearContents
      .Range("B" & i - 1 & ":B" & i).Merge
    Else
      If i > 5 Then .HPageBreaks.Add Before:=.Range("B" & i)
    End If
  Next i
End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub nonFusion()
Dim Dl As Range, Deb As Range, cel As Range
With Sheets("Feuil1") 'à adapter au nom de la feuille
  .ResetAllPageBreaks ' raz
  Set Dl = .Range("B" & .Rows.Count).End(xlUp)
  For Each cel In .Range("B5", Dl)
    If cel.MergeCells = True Then
      Set Deb = .Range(cel.MergeArea.Address)
      cel.MergeCells = False
      Deb = .Range(Split(Deb.Address, ":")(0))
    End If
  Next cel
End With
 
End Sub