Tableau croisé dynamique : soustraction

Bonjour à tous,

je vous sollicite car j'aimerais pour un tableau croisé dynamique mettre en rouge la cellule de la dernière ligne pour chaque colonne, si sa valeur est inférieure à celle du dessus (avant dernière ligne). Sachant que le nombre de ligne est variable.

Je n'ai pas trouvé la bonne méthode avec "mise en forme conditionnelle". Si c'est possible par macro je suis preneur.

Merci d'avance.

Cordialement,

Monak08

EDIT : Mea Culpa, je vous rajoute le fichier

Travailler sur des images, non ce n'est pas possible ... donne nous une version excel, on pourra plus facilement aussi expliquer comment faire la MFC.

Bonjour,

Mais si c'est possible ! Tiens, j'ai fait le premier, fait pareil sur les autres :

eric

Bonsoir,

La communauté est parfois bien facétieuse....

Merci pour vos réponses , j'ai rajouté le fichier

Cdt,

Monak

eriiic a écrit :

Bonjour,

Mais si c'est possible ! Tiens, j'ai fait le premier, fait pareil sur les autres :

eric

Merci eriiic , le faire pour une seule cellule j'arrive à le faire avec une MFC sur la cellule + formule simple. Mais je cherche justement à étendre la mise en forme.

Qu'est-ce qui te dit que ce n'est pas une MFC ?

En passant du filtre Bananes à Fraises, ta MFC est conservée ? Car c'est là le problème pour moi.

Non, un changement de filtre entraine une suppression de lignes qui crée une rupture dans la plage de la MFC.

VBA obligatoire :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim pvt As PivotTable, c As Range
    Set pvt = ActiveSheet.PivotTables("Tableau croisé dynamique1")
    pvt.DataBodyRange.EntireColumn.Interior.ColorIndex = xlNone
    For Each c In pvt.DataBodyRange.Offset(pvt.DataBodyRange.Rows.Count - 1).Resize(1)
        If c < c.Offset(-1) Then c.Interior.Color = vbRed
    Next
End Sub

eric

Bonjour eriiic,

merci pour ta réponse, le code fonctionne bien lorsque je le mets dans "Feuil3".

Cependant lorsque je souhaite créer les 4 feuilles (qui normalement récupèrent le code de "Feuil3"), via le bouton *Afficher TCD", j'ai une erreur d'éxecution '1004' : impossible de lire la propriété pivotTables de la classe Worksheet.

Cdt,

Monak

C'est bon j'ai trouvé mon erreur. J'ai rajouté le code dans ma boucle.

Merci eriiic

Petite question : en plus de mettre en rouge la cellule. Est-il possible de mettre l'onglet en rouge également ?

J'y arrive avec ce code associé à un bouton, mais lorsque le tableau dynamique (qui peut avoir de 4 à 5 colonnes) n'a pas la colonne E par exemple, j'ai l'erreur "Erreur définie par l'application ou par l'objet" qui remonte.

Private Sub cmdColorierOnglet_Click()
Dim ws As Worksheet
Dim TempSht As String

    For Each ws In ActiveWorkbook.Worksheets
        TempSht = ws.Name
        If Left(ws.Name, 4) = "tcd " Then
            If ws.Range("B65000").End(xlUp) < ws.Range("B65000").End(xlUp).Offset(-1) Then
                With Sheets(TempSht)
                .Tab.ColorIndex = 3 'rouge
                End With
            End If

            If ws.Range("C65000").End(xlUp) < ws.Range("C65000").End(xlUp).Offset(-1) Then
                With Sheets(TempSht)
                .Tab.ColorIndex = 3 'rouge
                End With
            End If

            If ws.Range("D65000").End(xlUp) < ws.Range("D65000").End(xlUp).Offset(-1) Then
                With Sheets(TempSht)
                .Tab.ColorIndex = 3 'rouge
                End With
            End If

            If ws.Range("E65000").End(xlUp) < ws.Range("E65000").End(xlUp).Offset(-1) Then
                With Sheets(TempSht)
                .Tab.ColorIndex = 3 'rouge
                End With
            End If
        End If
    Next ws
End Sub

Merci d'avance

Bonjour,

si tu avais analysé le code proposé tu aurais remarqué que pvt.DataBodyRange retourne un range de la plage des résultats de ton TCD.

Avec ça tu connais les colonnes existantes, se limiter à celles-ci.

Et pas la peine de répéter x fois le même code, créer une boucle sur les colonnes, sans oublier d'enlever le rouge quand il le faut.

eric.

Ok merci eriiic pour tes conseils, je vais regarder.

Cdt,

Monak

Bonjour,

Ma petite contribution du jour.

Cdlt.

Private Sub Worksheet_Activate()
    Me.PivotTables(1).PivotCache.Refresh
End Sub

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim n As Long, lCol As Long, lColEnd As Long
    With Target
        .DataBodyRange.Cells.Interior.ColorIndex = xlColorIndexNone
        n = .TableRange1.Cells(.TableRange1.Cells.Count).Row
        lColEnd = .TableRange1.Columns.Count
        For lCol = 2 To lColEnd
            If Cells(n, lCol) < Cells(n - 1, lCol) Then _
               Cells(n, lCol).Interior.ColorIndex = 3
        Next
    End With
End Sub

Bien vu le Worksheet_PivotTableUpdate, je crois que je n'y penserai jamais

Monak08, il me semble que ça serait mieux que tu colores tes onglets dans cette boucle plutôt que de dans une proc à part. Sans doute que tu peux fabriquer son nom (?) à partir du n° de colonne.

Bonjour Jean-Eric,

je viens de tester ça fonctionne également, je vais donc tenter de rajouter la couleur de l'onglet dedans.

Merci beaucoup.

Monak08

eriiic a écrit :

Bien vu le Worksheet_PivotTableUpdate, je crois que je n'y penserai jamais

Monak08, il me semble que ça serait mieux que tu colores tes onglets dans cette boucle plutôt que de dans une proc à part. Sans doute que tu peux fabriquer son nom (?) à partir du n° de colonne.

En effet, ça me paraît mieux et moins de code à écrire.

Merci.

Monak08

J'ai donc rajouté un peu de code, cependant tous les onglets contenant tcd deviennent rouge alors que j'ai inséré "ActiveSheet.Tab.Color = vbRed" dans le If.

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim n As Long, lCol As Long, lColEnd As Long
    For Each ws In ActiveWorkbook.Worksheets
        If Left(ws.Name, 4) = "tcd " Then
            With Target
        .DataBodyRange.Cells.Interior.ColorIndex = xlColorIndexNone
        n = .TableRange1.Cells(.TableRange1.Cells.Count).Row
        lColEnd = .TableRange1.Columns.Count
            For lCol = 2 To lColEnd
                If Cells(n, lCol) < Cells(n - 1, lCol) Then
               Cells(n, lCol).Interior.ColorIndex = 3
               ActiveSheet.Tab.Color = vbRed
                End If
            Next
            End With
        End If
    Next ws
End Sub

EDIT : d'ailleurs pas que les onglets contenant "tcd" mais dès que je clique sur un onglet.

Cdt,

Monak08

Re,

Un nouvel exemple à étudier.

Cdlt

Option Explicit

Dim WSName As String

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    With Sh
        WSName = .Name
        If .PivotTables.Count > 0 Then
            .PivotTables(1).PivotCache.Refresh
        End If
    End With
End Sub

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim n As Long, lCol As Long, lColEnd As Long
    If Target.Parent.Name <> WSName Then Exit Sub
    With Target
        If .Parent.Name <> Feuil2.Name Then
            .DataBodyRange.Cells.Interior.ColorIndex = xlColorIndexNone
            n = .TableRange1.Cells(.TableRange1.Cells.Count).Row
            lColEnd = .TableRange1.Columns.Count
            For lCol = 2 To lColEnd
                With Sh
                    If .Cells(n, lCol) < .Cells(n - 1, lCol) Then
                        .Cells(n, lCol).Interior.ColorIndex = 3
                        .Tab.ColorIndex = 3
                    End If
                End With
            Next
            MsgBox "Mise à jour " & Sh.Name & " - " & Target.Name
        End If
    End With
End Sub

Merci Jean-Eric c'est parfait.