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

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

  • Derligne.xlsm
    89.8 KB · Affichages: 17
Trier par date Trier par votes
job75

job75

XLDnaute Barbatruc
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

  • Sous-Totaux_cours_répartition(4).xlsm
    82.4 KB · Affichages: 12
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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
T

thespeedy20

XLDnaute Occasionnel
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
job75

job75

XLDnaute Barbatruc
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

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Mon code ne reconnait pas la dernière ligne de mon tableau
Réponses
4
Affichages
373
Soumie
S
M
  • Question
Microsoft 365 Colonne de la feuille 1 envoyer en une ligne sur la feuille 2
Réponses
0
Affichages
318
marcmarc
M
M
  • Question
Microsoft 365 N'afficher que la dernière ligne d'un tableau dans listbox
Réponses
9
Affichages
405
meyscal
M
N
  • Question
XL 2013 Comment insérer une ligne vide à chaque changement de valeur sur la colonne A
2
Réponses
16
Affichages
2 K
nacho31
N
Nono1835
  • Question
XL pour MAC dernière ligne tableau avant changement de page
Réponses
1
Affichages
653
AtTheOne
AtTheOne
H
  • Résolu(e)
Microsoft 365 Incrémentation d'un numéro de devis/facture
2
Réponses
24
Affichages
2 K
dysorthographie
dysorthographie
T
  • Question
XL 2019 Ajustement automatique Hauteur de ligne en fonction du texte variable
Réponses
7
Affichages
1 K
thespeedy20
T
S
  • Résolu(e)
Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date
Réponses
8
Affichages
864
Sylvain. B
S
P
  • Question
XL 2016 Ligne qui se copie automatiquement sur une autre feuille, Transfert de ligne sur une autre page
Réponses
1
Affichages
793
PascaleMT
P
G
  • Question
Microsoft 365 filtrer / défiltrer insertion de ligne automatique - macro qui ne fonctionne pas ou de manière aléatoire
Réponses
4
Affichages
1 K
Grelune
G

Membres actuellement en ligne

3 membres et 78 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 389
Messages
2 087 933
Membres
103 678
dernier inscrit
bibitm