Sous-totaux sur la dernière ligne avant changement de page

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
T

thespeedy20

XLDnaute Occasionnel
Bonjour le Forum,

Bonjour
@job75

Tu m'avais aidé pour mon projet à l'époque....

Ici j'aimerais que la ligne des sous-totaux s'indique sur la dernière ligne de chaque fin page

j'ai utilisé

VB: 
HPageBreaks.Item(1).Location.Cells.Row - 1

mais cela ne semble pas fonctionner.....

Une petite aide pour solutionner mon problème....

Merci d'avance

Oli
 

Pièces jointes

Trier par date Trier par votes
Bonjour thespeedy20,

Il y a 2 choses qui ne vont pas dans votre question :

- vous n'utilisez pas le dernier fichier (3) que je vous ai fourni sur ce fil il y a 3 ans :

https://www.excel-downloads.com/thr...us-totaux-total.20006787/page-2#post-20050367

- vous voulez placer les sous-totaux par rapport aux sauts de page existants, ce qui change tout et rend caduques [Edit caducs] tous mes codes.

A la réflexion je pense qu'il faut faire l'inverse : placer les sauts de page après avoir créé les sous-totaux.

Alors c'est assez simple, il suffit de terminer la macro Affiche_Masque avec ce code :
VB: 
'---mise en page---
F1.PageSetup.PrintArea = F1.Columns(1).Resize(, ncol).Address: F2.PageSetup.PrintArea = "$A:$F"
F1.PageSetup.PrintTitleRows = F1.Rows(1).Resize(ntitre1).Address: F2.PageSetup.PrintTitleRows = F2.Rows(1).Resize(ntitre2).Address
F1.PageSetup.Zoom = False: F2.PageSetup.Zoom = False
F1.PageSetup.FitToPagesWide = 1: F2.PageSetup.FitToPagesWide = 1 '1 page en largeur
'---sauts de page---
F1.ResetAllPageBreaks: F2.ResetAllPageBreaks 'RAZ
If affiche Then
    For Each c In F1.[A1].CurrentRegion.Columns(2).Cells
        If c = "Sous-total" And c(nvide + 2) <> "Total" Then F1.HPageBreaks.Add Before:=c(2)
    Next
    For Each c In F2.Range("A1", F2.UsedRange).Columns(1).Cells
        If c = "Sous-total" And c(nvide + 2) <> "Total" Then F2.HPageBreaks.Add Before:=c(2)
    Next
End If
Voyez ce fichier (4), pour mettre en évidence les sauts de page utilisez la commande "Avec sauts de page" du menu Affichage.

Et faites aussi défiler les "Aperçus avant impression" pour vérifier.

A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Pour l'impression il est logique de rechercher le pas qui donne le minimum de pages.

Inutile de faire des choses compliquées, il se trouve facilement par tâtonnement.

Par exemple sur le fichier du post précédent le pas optimal chez moi est 44 qui donne 14 pages à imprimer sur chaque feuille.
 
Vote positif 0 Vote négatif
re,

Je viens d'essayer avec la macro qui était de base avant les sous-totaux...ici elle prend une plombe et excel ne répond plus....

VB: 
Sub Répartir()
    Dim TR(), n%, i%, np$, clr&
    With Worksheets("Liste")
        'Ajout colonne pour ordonner tri domaine en musique / parole / danse
        'Tri et effacement colonne ajoutée
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            If .Cells(i, 5) Like "*MUSIQUE*" Then
                .Cells(i, 7) = 1 & .Cells(i, 3)
            ElseIf .Cells(i, 5) Like "*PAROLE*" Then
                .Cells(i, 7) = 2 & .Cells(i, 3)
            ElseIf .Cells(i, 5) Like "*DANSE*" Then
                .Cells(i, 7) = 3 & .Cells(i, 3)
            End If
        Next i
        .Range("A2:G" & n).Sort key1:=.Range("A2"), order1:=xlAscending, key2:=.Range("B2"), _
         order2:=xlAscending, key3:=.Range("G2"), order3:=xlAscending, Header:=xlNo
        .Range("G2:G" & n).ClearContents
        'Recueil des données
        ReDim TR(n - 1, 3)
        For i = 2 To n
            np = .Cells(i, 1) & " " & .Cells(i, 2)
            If np <> TR(0, 1) Then TR(i - 1, 1) = np
            TR(0, 1) = np
            TR(i - 1, 2) = .Cells(i, 3)
            TR(i - 1, 3) = .Cells(i, 4) & " (" & .Cells(i, 6) & ")"
            If .Cells(i, 5) Like "*MUSIQUE*" Then
                TR(i - 1, 0) = 1
            ElseIf .Cells(i, 5) Like "*PAROLE*" Then
                TR(i - 1, 0) = 3
            ElseIf .Cells(i, 5) Like "*DANSE*" Then
                TR(i - 1, 0) = 5
            End If
        Next i
    End With
    'Affectation nouveau tableau
    With Worksheets("Répartition")
        For i = 1 To n - 1
            .Cells(i + 2, 2) = TR(i, 1)
            .Cells(i + 2, 2 + TR(i, 0)) = TR(i, 2)
            .Cells(i + 2, 3 + TR(i, 0)) = TR(i, 3)
        Next i
    'Coloration
        For i = 0 To 4 Step 2
            With Range("C2:D2").Offset(, i)
                clr = .Interior.Color
                .Resize(n).Interior.Color = clr
            End With
        Next i
    'Formule col. A et bordure tour colonne
        With .Range("A3")
            .Formula = "=If(B3<>"""",Counta($B$3:B3),"""")"
            .AutoFill .Resize(n - 1)
            With .Resize(n - 1)
                .HorizontalAlignment = xlCenter
                .BorderAround xlContinuous, xlThin
            End With
        End With
    'Bordures tableau
        With .Range("A3:H" & n + 1).Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    'Formules récapitulatives
        ''.Range("C" & n + 3).Formula = "=Counta(C3:C" & n + 1 & ")"
       '' .Range("D" & n + 3).FormulaArray = "=Sum(If(R3C:R" & n + 1 & "C<>"""",Value(Mid(R3C:R" _
       ''  & n + 1 & "C,Len(R3C:R" & n + 1 & "C)-1,1)),0))"
       '' .Range("C" & n + 3 & ":D" & n + 3).Copy
       '' .Range("E" & n + 3).PasteSpecial xlPasteAll
       '' .Range("G" & n + 3).PasteSpecial xlPasteAll
        ''.Range("C" & n + 3 & ":H" & n + 3).HorizontalAlignment = xlCenter
    End With
End Sub

Dans le fichier original, elle ne dure que quelques secondes....

Pouvez-vous jeter un œil....

Merci beaucoup

Oli
 
Vote positif 0 Vote négatif
J'ai l'impression que vous n'avez pas bien compris le fonctionnement du fichier que je vous ai donné.

Effacez le tableau de la feuille "Cours" sauf les 2 lignes des titres.

La feuille "Répartition" étant elle remplie et affichée appuyez sur les touches Ctrl+A => la feuille "Cours" se remplit.

Et vice versa.
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
1 K
Gestionnaire_rh
G
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
914
spike29
S
J
  • Question Question
XL 2019 (Résolu) VBA - Mise en surbrillance de ligne (fonction dans ruban)
Réponses
3
Affichages
649
Julien_B
J
A
  • Résolu(e)
XL 2019 Inventaire
Réponses
2
Affichages
555
Aurélien-D
A
S
  • Résolu(e)
Microsoft 365 Mon code ne reconnait pas la dernière ligne de mon tableau
Réponses
4
Affichages
631
Soumie
S
P
  • Résolu(e)
XL 2021 Requête API - VBA Excel - Parse JSON
Réponses
2
Affichages
483
picc
P
M
  • Question Question
XL 2010 (Génération d'invitations) Erreur 424 ???
2
Réponses
17
Affichages
1 K
patricktoulon
patricktoulon
M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
2 K
sousou
sousou
D
  • Résolu(e)
Microsoft 365 Graphique avec plage de données glissante en partant d'une date
Réponses
5
Affichages
778
Dégé59
D
M
  • Résolu(e)
XL pour MAC Fonction peut s'adapter au changement de ligne ?
Réponses
4
Affichages
673
MaiBZH
M
X
  • Question Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
758
Xender
X
L
  • Résolu(e)
XL 2019 Renvoyer une valeur colonne A avec la dernière valeur de la colonne B
Réponses
5
Affichages
580
Gégé-45550
Gégé-45550
A
  • Question Question
XL 2016 Sous-totaux ou WorksheetFunction.Sum
Réponses
2
Affichages
775
Aldonanou
A
N
  • Question Question
XL 2013 Comment insérer une ligne vide à chaque changement de valeur sur la colonne A
2
Réponses
16
Affichages
3 K
nacho31
N
M
  • Question Question
Microsoft 365 N'afficher que la dernière ligne d'un tableau dans listbox
Réponses
9
Affichages
865
meyscal
M
M
  • Question Question
Microsoft 365 Colonne de la feuille 1 envoyer en une ligne sur la feuille 2
Réponses
0
Affichages
507
marcmarc
M
J
  • Question Question
XL 2010 "Figer" une cellule lors de l'incrémentation d'une ligne
Réponses
3
Affichages
721
jigour
J
H
  • Question Question
Microsoft 365 Calcul d'une somme de données entre 2 dates (1 ancienne et aujourd'hui)
Réponses
13
Affichages
986
Heian911
H
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
1 K
Vermithor
V
S
  • Question Question
XL 2019 Saut de page si une ligne contenant une certaine valeur se trouve en bas de page
Réponses
3
Affichages
466
Wayki
Wayki
Retour