Filtre d'un TCD en VBA

22statut.xlsm (23.99 Ko)

bonjour,

j'ai fait un TCD en utilisant l'editeur vba, ensuite j'ai fait un peu de nettoyage dans le code pour l'alleger.

depuis la feuille ''donnees'' j'ai le tcd dans la feuille ''synthese'' filtre sur le mot ''nouveau'' de la colonne ''statut''.

sachant que la feuille donnees peut avoir differentes donnees.

tout fonctionne bien, sauf:

quand la colonne ''statut'' ne contient pas un de ses criteres ( Résolu ou Fixé ou Résolution en c). le code stop en m;indiquant une erreur sur le critere (mot) qui manque, parce qu'en realite une commande dans le code ne trouve pas le mot recherché.

ci-dessous le code:

Sub triestatut()
'
' triestatut Macro
'

'effacer la feuille
Sheets("synthese").Select
Cells.Clear

'creation du tcd

    Sheets("donnees").Select

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "donnees!R1C1:R40C5", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="synthese!R3C1", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion14

    Sheets("synthese").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("date achat")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUT")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("date achat"), "Count of date achat", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUT")
        .PivotItems("Fixé").Visible = False
        .PivotItems("Résolu").Visible = False
        .PivotItems("Résolution en c").Visible = False
    End With
End Sub

si par exemple il trouve pas le mot ''Fixé'' il bloque dans

.PivotItems("Fixé").Visible = False

utiliser on error resume next ne resout pas le probleme.

merci pour votre retour.

Bonjour,

Un peu confuse la question.

Voir fichier cependant, et chercher l'erreur

Cdlt

23statut.xlsm (23.92 Ko)
Option Explicit
Option Private Module
Public Sub TTnouveau()
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim pi As PivotItem

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    On Error Resume Next
    Worksheets("Synthese").Delete
    On Error GoTo 0

    Application.DisplayAlerts = False

    Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, [Tableau1[#ALL]], 4)

    ActiveWorkbook.Worksheets.Add before:=Worksheets(2)
    ActiveSheet.Name = "Synthese"

    Set pt = ptCache.CreatePivotTable([A3], "TCD1", , 4)

    pt.ManualUpdate = True

    pt.AddFields _
            RowFields:="Date CREATE", _
            ColumnFields:="STATUT"

    With pt.PivotFields("NUM INCIDENT")
        .Orientation = xlDataField
        .Function = xlCount
        .NumberFormat = "#,##0"
        .Caption = "NUM INCIDENT "
    End With

    pt.RowAxisLayout xlTabularRow
    pt.ColumnGrand = True
    pt.TableStyle2 = "PivotStyleDark2"

    pt.ManualUpdate = False
    pt.DataBodyRange.HorizontalAlignment = xlCenter
    pt.ManualUpdate = True

    With pt.PivotFields("STATUT")
        On Error Resume Next
        For Each pi In .PivotItems
            If pi.Name <> "Nouveau" Then pi.Visible = False
        Next
        On Error GoTo 0
    End With

    pt.ManualUpdate = False

    Set pt = Nothing
    Set ptCache = Nothing

End Sub

Bonjour,

dsl pour le retard et merci pour cette réponse.a priori ca fonctionne,je vais le tester en utilisant la totalité des données et je reviens vers vous ( je vous ai donné qu'une partie du problème).

en attendant est ce possible de faire des commentaires dans le code,question de comprendre votre stratégie.

merci encore une fois.

Bonjour,

j'essaie généralement que mes procédures soient explicites.

J'ai relu cette dernière et elle est compréhensible (et pas trop différente de la tienne).

Pour plus d'informations, dans un premier temps, un double clic sur un terme précis dans le code, puis F1, est magique.

Ensuite, s'il y a un point particulier à voir, reviens vers moi.

Cdlt.

bonjour,

merci quand meme. j'ai trouve des commentaires sur un script un peu pareil dans l'un de vos postes.

j'ai fait qqs modif sur le code, ca semble repondre aux besoins ^^

merci a vous.

Bonsoir,

Tu peux donc clore le sujet.

Bonnes fêtes de fin d'année.

Cdlt.

bjr,

a vous également merci.

Rechercher des sujets similaires à "filtre tcd vba"