Discussion :

[thespeedy20]

Bonjour,

J'ai un code qui permet d'afficher les sous-totaux toutes les 30 lignes(via une constante), j'aimerais si c'est possible d'afficher les sous-totaux en fin de chaque page.

je sais que je peux Connaitre la dernière ligne de la page avec la fonction suivante : HPageBreaks(1).Location.Row.

Mais je vois pas dans le code ou faire une boucle qui me permettrait d'avoir les sous-totaux en fin de page... il y a un bouton qui permet l'affichage ou des sous-totaux et pour compliquer le tout, la feuille cours et répartition sont liées....

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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
 
Sub SousTotauxCours(affiche As Boolean)
 
 
Dim pasplus&, t, nlig&, rest(), soustotal(), total(), i&, num&, n&, j%, v, test As Boolean
pasplus = pas 'pour incrémentation
'---initialisation---
With [A1].CurrentRegion
  t = .Resize(, ncol) 'matrice, plus rapide
  nlig = .Rows.Count
  ReDim rest(1 To nlig + Int(nlig / pas) + nvide + 2, 1 To ncol)
End With
ReDim soustotal(1 To ncol)
ReDim total(1 To ncol)
'---remplissage du tableau rest---
For i = 4 To nlig
  If InStr(LCase(t(i, 2)), "total") = 0 Then
    num = num + 1
    n = n + 1
    For j = 1 To ncol
      v = t(i, j)
      If v <> "" Then
        rest(n, j) = v
        If j > 2 Then
          If j Mod 2 Then 'colonnes C E G
            test = False
            test = i = 4 Or t(i, 2) <> ""
            If i > 1 Then test = test Or t(i - 1, j) = ""
            If test Then soustotal(j) = soustotal(j) + 1
          Else 'colonnes D F H
            soustotal(j) = soustotal(j) + 1
          End If
        End If
      End If
    Next j
    If affiche And num = pasplus Then
      If i < nlig Then If t(i + 1, 2) = "" Then pasplus = pasplus + 1: GoTo 1
      n = n + 1
      rest(n, 2) = "Sous-total"
      For j = 3 To ncol
        rest(n, j) = soustotal(j)
        total(j) = total(j) + soustotal(j)
      Next j
      ReDim soustotal(1 To ncol) 'RAZ
      pasplus = pas: num = 0
    End If
  End If
1 Next i
'---les 2 dernières lignes du tableau rest---
If affiche Then
  If n Then
    If rest(n, 2) <> "Sous-total" Then
      n = n + 1
      rest(n, 2) = "Sous-total"
      For j = 3 To ncol
        rest(n, j) = soustotal(j)
        total(j) = total(j) + soustotal(j)
      Next j
    End If
  End If
  n = n + nvide + 1
  rest(n, 2) = "Total"
  For j = 3 To ncol
    rest(n, j) = total(j)
  Next j
End If
'---restitution---
If n Then [A4].Resize(n, ncol) = rest
Rows(n + 4 & ":" & Rows.Count).ClearContents
With Me.UsedRange: End With 'actualise la barre de défilement
Repartition affiche, rest(), n 'appelle la macro
End Sub
 
Sub Repartition(affiche As Boolean, rest(), n&)
Dim domaine, restrep(), i&, v$, j%, x$, y$, subvention&
domaine = [A2].Resize(, ncol) 'à adapter éventuellement
ReDim restrep(1 To UBound(rest), 1 To 6)
ReDim total(1 To 5)
For i = 1 To IIf(affiche, n - nvide - 1, n)
  v = rest(i, 2)
  If v <> "Sous-total" Then
    If v <> "" Then
      v = v & " " 's'il n'y a pas de prénom
      For j = 1 To Len(v) 'recherche du prénom
        x = Mid(v, j, 1): y = Mid(v, j + 1, 1)
        If x = UCase(x) And y = LCase(y) And y <> " " _
          And y <> "-" And y <> "'" Then Exit For
      Next j
      restrep(i, 1) = Trim(Left(v, j - 1)) 'nom
      restrep(i, 2) = Trim(Mid(v, j)) 'prénom
    ElseIf i > 1 Then
      restrep(i, 1) = restrep(i - 1, 1) 'copie le nom
      restrep(i, 2) = restrep(i - 1, 2) 'copie le prénom
    End If
    For j = 3 To ncol Step 2
      If rest(i, j) <> "" Then
        restrep(i, 3) = rest(i, j) 'cours
        restrep(i, 6) = domaine(1, j) 'domaine
        v = rest(i, j + 1)
        j = InStr(v & "(", "(")
        restrep(i, 4) = Left(v, j - 1) 'deg
        restrep(i, 5) = Val(Mid(v, j + 1)) 'subvention
        subvention = subvention + restrep(i, 5)
        Exit For
      End If
    Next j
  Else
    restrep(i, 1) = v 'Sous-total
    For j = 3 To ncol Step 2
      restrep(i, 3) = restrep(i, 3) + rest(i, j)
      restrep(i, 4) = restrep(i, 4) + rest(i, j + 1)
    Next j
    restrep(i, 5) = subvention: subvention = 0
    For j = 3 To 5
      total(j) = total(j) + restrep(i, j)
    Next j
  End If
Next i
'---dernière ligne---
If affiche Then
  restrep(n, 1) = "Total": restrep(n, 3) = total(3)
  restrep(n, 4) = total(4): restrep(n, 5) = total(5)
End If
'------
With Feuil2 'CodeName
  If n Then .[A3].Resize(n, 6) = restrep
  .Rows(n + 3 & ":" & .Rows.Count).ClearContents
  .Columns.Resize(, 6).AutoFit 'ajuste la largeur
  .CommandButton1.Width = .[A1:B1].Width
  With .UsedRange: End With 'actualise la barre de défilement
End With
End Sub

Je vous remercie pour l'aide apportée

Oli

[Qwazerty]

Salut

Dans le principe il vaudrait mieux remplir tout ton tableau sans mettre de totaux toutes les 30 lignes, puis en fin de code tu boucles sur les sauts de pages et tu insert tes lignes de totaux.
A chaque insertion tu mémorises le numéro de ligne dans une variable et lorsque tu inserts la ligne de total suivante, tu utilises la ligne mémorisée avant pour définir la plage qui doit être prise en compte pour faire tes sous totaux.

Du moins c'est ce que je ferrais

[Edit]
Par contre fait attention à la mise en page, ton tableau se retrouve sur 2 "colonnes" de pages/
[/Edit]
++
Qwaz

[thespeedy20]

Bonsoir Qwazerty,

Peux-tu m'aider à la réaliser car je suis un peu perdu....

Ce serait vraiment sympa de ta part

Merci

Oli

[thespeedy20]

re,

voici ma boucle pour les sous-totaux,qui met à la dernière ligne mais les sous-totaux ne sont pas juste!!!

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
 
'sous-totaux
n = 0
For Z = 1 To Sauts_naturels
    num_cells = HPageBreaks(Z).Location.Row
        n = HPageBreaks(Z).Location.Row - 5
 
 n = n + 1
        rest(n, 2) = "Sous-total"
        For j = 3 To ncol
        rest(n, j) = soustotal(j)
        total(j) = total(j) + soustotal(j)
        Next j
 
Next Z

[Qwazerty]

Salut

Essai avec ça.
J'ai modifier un peu la structure du tableau (tableau structuré) par contre ça risque de ne plus très bien marcher avec le reste des macros.
C'est un bon réflexe je pense que d'utiliser les tableauxs tructurés dès que possible.

++
Qwaz

[thespeedy20]

Bonjour Qwazerty,

Grand merci pour ta proposition....

pour le sous-totaux des colonnes C - E - G, il ne faut compter toutes les valeurs....pour les colonnes D - F -H , c'est OK

Petites explications:

Si un élève suit par ex dans le domaine de Musique : 3 cours, il ne compte que pour 1, même chose dans le domaine de la parole et danse....

donc pour la première page, les sous-totaux donneraient 20 pour le domaine musique, 5 dans le domaine parole et 7 pour la danse...

Peux-tu adapter la formule....

Je te remercie encore et excellent dimanche

Oli

[thespeedy20]

Bonsoir Qwazerty,

as-tu pu regarder pour adapter la formule ?

Je te remercie

Oli

[Qwazerty]

Salut

J'ai regardé mais la structure de départ du tableau n'aide pas, je ne suis pas très au point sur les formules, il faudrait reposer une question dans la section Excel (sans VBA).
La formule doit être capable de comptabiliser 1 si la personne à au moins une activité dans un domaine spécifique. Hors vu qu'une partie des cases "Nom" sont vides ça ne facilite pas la tache. Il doit falloir utiliser une formule matricielle mais je mets toujours du temps à les pondre... quand j'y arrive, donc je préfère laisser la main à d'autres

++
Qwaz

[thespeedy20]

Bonsoir Qwazerty

ARTURO83 du forum excel à trouver une solution pour calculer les élèves par domaine, je te joins le fichier....

Peux-tu regarder et voir si tu sais l'adapter sur ta macro, car celle d'arturo83 ne masquent pas, ni n'affichent les sous-totaux.... et d'afficher un total général , 2-3 lignes après le dernier sous-total...

Grand Merci

Oli

[Qwazerty]

Salut

Le faire sans mettre de formule, juste avec du VBA ne me posait pas de problème.
Par contre 2 choses:

1. Sans formule, si tu modifies la liste il faudra mettre à jour les sous totaux "à la main"
2. En codant la macro de calcul je me rend compte qu'il y a un problème, les lignes de sous totaux sont parfois en plein milieu des activités d'une même personne.

Pour le point 1, je te propose un code sans les formule à toi de voir si tu fais une demande ou pas pour avoir une formule "propre" qui se mettra à jour.

Pour le point 2, je te propose de décaler le sous total pour qu'il soit juste au dessus du précédent nom inscrit dans la colonne "Nom + Prenom" et en décalant le saut de page à ce niveau

Les modifications au niveau du fichier
Dans la section Mise en page, sélectionner "1 page" pour la largeur

Pour le code

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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Sub SousTotauxCoursBis(Optional Affiche As Boolean = True) 'vrai par défaut si omis
Dim iCell As Long
Dim aHBreak As HPageBreak, LastBreak As ListRow, iheader As Integer, iHPB As Integer
Dim TabInterne
Dim NewRow As ListRow
Dim iCol As Integer, iRow As Long
Dim IsNewNom As Boolean, OldName As String, iSomme As Long
 
    'On verrouille l'affichage
    Application.ScreenUpdating = False
 
    'On pointe le tableau structuré
    With Feuil1.ListObjects("Tab_Cours")
        'On mémorise où se trouve le tableau dans la feuille excel
        iheader = .HeaderRowRange.Row + 1
        Set LastBreak = .ListRows(1)
 
        If Affiche Then
            'On boucle sur les sauts de page
            'On utilise While loop car si le fait d'ajouter des ligne ajoute une page ellene serait pas prise en compte avec une boucle For
            iHPB = 1
            While iHPB <= Feuil1.HPageBreaks.Count
                Set aHBreak = Feuil1.HPageBreaks(iHPB)
                'On recherche la dernière cellule non vide de la colonne Nom + Prénom
                iRow = aHBreak.Location.Row - iheader
                If .ListRows(iRow).Range(1, .ListColumns("NOM + PRENOM").Index).Value = "" Then
                    'Cellule vide
                    iRow = .ListRows(iRow).Range(1, .ListColumns("NOM + PRENOM").Index).End(xlUp).Row - iheader + 1
                End If
                'On ajoute une ligne de sous-total
                Set NewRow = .ListRows.Add(iRow)
                'On ajoute le titre
                NewRow.Range(, 2) = "Sous-total"
 
                'On remplace le pagebreack si necessaire
                If aHBreak.Location.Row - iheader <> iRow Then
                    'On place un breack manuel
                    NewRow.Range.Offset(1).PageBreak = xlPageBreakManual
                End If
 
                For iCol = 3 To 8
                    'Raz
                    iSomme = 0
                    'On boucle sur les cellules amont
                    For iRow = LastBreak.Index To NewRow.Index
                        'On regarde si une activité est présente
                        If (.ListRows(iRow).Range(1, .ListColumns(iCol).Index).Value <> "") Then
                            'On regarde s'il y a un nom
                            If .ListRows(iRow).Range(1, .ListColumns("NOM + PRENOM").Index).Value <> "" Then
                                'On ajoute une activité au sous-total
                                IsNewNom = True
                            Else
                                'Cellule vide, on va chercher à qui appartient l'activité
                                If OldName <> .ListRows(iRow).Range(1, .ListColumns("NOM + PRENOM").Index).End(xlUp).Value Then
                                    'Personne différente
                                    IsNewNom = True
                                End If
                            End If
 
                            If IsNewNom Then
                                'On ajoute une activité au sous-total
                                iSomme = iSomme + 1
                                'On conserve le nom
                                OldName = .ListRows(iRow).Range(1, .ListColumns("NOM + PRENOM").Index).Value
                                'Raz
                                IsNewNom = False
                            End If
                        End If
                    Next
                    'On place la Somme dans dans sous total
                    NewRow.Range(1, iCol).Value = iSomme
                Next
                iHPB = iHPB + 1
                Set LastBreak = .ListRows(NewRow.Index + 1)
            Wend
 
        Else
            'On boucle sur les ligne en partant du bas
            For iRow = .ListRows.Count To 1 Step -1
                'On teste la ligne
                If StrComp(.ListRows(iRow).Range(, 2), "Sous-total", vbTextCompare) = 0 Then .ListRows(iRow).Delete 'On supprime la ligne
            Next
            'On reset les pagesbreack
            Feuil1.ResetAllPageBreaks
        End If
    End With
 
End Sub

++
Qwaz