Macro VBA TablePivot

Version imprimable

Bonjour,

Je débute sur VBA et je rencontre un problème avec le code suivant:

Code:

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
Sub Developpement()
Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Data!R1C1:R461C11", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Feuil7!R3C1", TableName:="Tableau croisé dynamique6", _
        DefaultVersion:=xlPivotTableVersion10
    Sheets("Feuil7").Select
    Cells(3, 1).Select
    
    With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "Qualification")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields("Motif")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "Affecté à")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "Services")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "Nom commercial")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique6").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique6").PivotFields("CA"), "Somme de CA", _
        xlSum
    ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "Qualification").ClearAllFilters
    ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields( _
        "Qualification").CurrentPage = "Développement "
    ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields("Motif"). _
        ClearAllFilters
    ActiveSheet.PivotTables("Tableau croisé dynamique6").PivotFields("Motif"). _
        CurrentPage = "Commercial "
    Sheets("Feuil7").Select
    Sheets("Feuil7").Name = "TCD Développement"
    Range("E31").Select
End Sub

J'ai créé ce code via l'enregistrement de macros sur Excel, il fonctionnait au départ mais plus maintenant. Autre chose, la feuille contenant mes données est variable chaque mois, je cherche un code qui tiendrais compte de cela.

D'avance merci.

29/07/2014, 11h16
Invité

Bonjour, regardes ça

http://www.developpez.net/forums/d14...s/#post7910857

Bonjour rdurupt,

Je te remercie pour le lien, ton tableau est très bien mais très compliqué pour mon faible niveau.

Je veux simplement modifier:

Code:

SourceData:= _"Data!R1C1:R461C11"

dans le code pour que le TCD s'adapte en fonction de la taille de la base de données

et

Code:

TableDestination:="Feuil7!R3C1"

pour créer le TCD dans un onglet nommé directement pour éviter la manip
Code:

1 2 Sheets("Feuil7").Select Sheets("Feuil7").Name = "TCD Développement"
en fin de code.
Code:

1 2 3 4 5 6 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "Data!R1C1:R461C11", Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Feuil7!R3C1", TableName:="Tableau croisé dynamique6", _ DefaultVersion:=xlPivotTableVersion10 Sheets("Feuil7").Select Cells(3, 1).Select

29/07/2014, 12h17
Philippe Tulliez

Bonjour,

Citation:

Je te remercie pour le lien, ton tableau est très bien mais très compliqué pour mon faible niveau.

Pourtant, plus simple que cela, c'est difficile.
Pour obtenir l'adresse d'une plage de cellules dynamiquement, tu as plusieurs possibilités dont en voici deux
Soit

Code:

ThisWorkbook.Worksheets("db").UsedRange

ou (si la plage de données commence à la cellule A1)

Code:

ThisWorkbook.Worksheets("db").Range("A1").CurrentRegion

Pour le premier code, il faut que la plage de données soit seule sur la feuille
29/07/2014, 12h30
Invité

Bonjour,Philippe

les classe ça affole mais quand on regarde le code ça simplifie grandement!

Correction balises

Citation:

Envoyé par Philippe Tulliez

Bonjour,

Pourtant, plus simple que cela, c'est difficile.

Je dois vraiment être nul mais cela ne fonctionne toujours pas:

Code:

1
2
3
4
5
6
7
Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        ThisWorkbook.Worksheets("Data").Range("A1").CurrentRegion, Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Feuil7!R1C1", TableName:="Tableau croisé dynamique6", _
        DefaultVersion:=xlPivotTableVersion14
    Sheets("Feuil7").Select
    Cells(3, 1).Select

J'ai trouvé un autre code qui fonctionne bien mais pour celui la je n'arrive pas à paramétrer les filtres correctement:

Code:

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
Sub CreatePivotdev()
 
    Dim objTable As PivotTable, objField As PivotField
    ActiveWorkbook.Sheets("Data").Select
    Range("A1").Select
 
    With ActiveSheet.PivotTables("Tableau croisé dynamique12").PivotFields( _
        "Qualification")
        .PivotItems("Apport vente ").Visible = False
        .PivotItems("Fin suspension fact. ").Visible = False
        .PivotItems("Hausse tarifaire ").Visible = False
        .PivotItems("Perte ").Visible = False
        .PivotItems("Perte partielle ").Visible = False
        .PivotItems("Rénégo tarifs ").Visible = False
        .PivotItems("Suspension fact. ").Visible = False
        .PivotItems("Transfert inter-centre ").Visible = False
        .PivotItems("Variation d'activité ").Visible = False
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique12").PivotFields("Motif")
        .PivotItems("Cessation d'activité ").Visible = False
        .PivotItems("Changement de propriétaire ").Visible = False
        .PivotItems("Concurrence ").Visible = False
        .PivotItems("(blank)").Visible = False
    End With
 
    ActiveSheet.PivotTables("Tableau croisé dynamique12").PivotFields( _
        "Qualification").Subtotals = Array(False, False, False, False, False, False, False, _
        False, False, False, False, False)
    Range("D12").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique12").PivotFields("Motif"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
 
    Set objTable = Data.PivotTableWizard
 
    Set objField = objTable.PivotFields("Services")
    objField.Orientation = xlRowField
    Set objField = objTable.PivotFields("Qualification")
    objField.Orientation = xlRowField
    Set objField = objTable.PivotFields("Motif")
    objField.Orientation = xlRowField
    Set objField = objTable.PivotFields("Affecté à")
    objField.Orientation = xlRowField
 
    Set objField = objTable.PivotFields("CA")
    objField.Orientation = xlDataField
    objField.Function = xlSum
    objField.NumberFormat = "#,##0.00 $"
 
End Sub

Le problème vient du fait (à mon avis) qu'il faut que j'appelle le TCD de manière dynamique au lieu de "Tableau croisé dynamique12"

Code:

1
2
3
ActiveSheet.PivotTables("Tableau croisé dynamique12").PivotFields( _
        "Qualification").Subtotals = Array(False, False, False, False, False, False, False, _
        False, False, False, False, False)

29/07/2014, 13h47
Philippe Tulliez

Bonjour,

Citation:

Je dois vraiment être nul mais cela ne fonctionne toujours pas:

Qu'est-ce qui ne fonctionne pas ?
Il ne se passe rien, il y a un message d'erreur si oui quel numéro et quel en est le texte ?

Message d'erreur 5, il me surligne le code ci-dessous en jaune:
Code:

1 2 3 4 ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ ThisWorkbook.Worksheets("Data").Range("A1").CurrentRegion, Version:=xlPivotTableVersion14).CreatePivotTable _ TableDestination:="Feuil7!R1C1", TableName:="Tableau croisé dynamique6", _ DefaultVersion:=xlPivotTableVersion14
Citation:

Envoyé par rdurupt

les classe ça affole mais quand on regarde le code ça simplifie grandement!

Il est vrai que ça affole quand on connait pas parfaitement le langage.

Si j'ai bien suivi:
Code:

1 2 3 4 5 6 7 8 9 TDC.CreerTableau ActiveWorkbook, "DATA!" & Sheets("DATA").UsedRange.Address, "TDC", "DATA" TDC.NewPivotTables "DATE", TypeFiltre TDC.NewPivotTables "DATES", TypeFiltre TDC.NewPivotTables "FOURNISSEUR", Typeligne, True TDC.NewPivotTables "PIECE", Typeligne, True TDC.NewPivotTables "REF", TypeColonne, True TDC.NewDataField "MONTANT", Somme TDC.AfficheTotal True, True TDC.Style PivotStyleMedium9
"DATE"; "DATES"; sont les titres de tes colonnes et les TypeFiltre sont paramétrables.

Si True est placé le TCD les affiche, si il n'y a rien ils ne sont pas affichés?

29/07/2014, 14h11
Invité

nom ça concerne les sous totaux mais je peux rajouter cette condition!
29/07/2014, 14h26
zielite

J'ai compris le principe de ton tableau! Top!

Si je veux filtrer automatiquement par exemple dans le champ "motif" je ne veux que l'item "Commercial" comment je procède?

il faut rajouter ça dans le module de classe ClsTdcRd

Code:

1
2
3
4
5
6
7
8
9
10
11
Public Sub FiltrePivotTables(Champ As String, V As String)
On Error Resume Next
Dim I As Integer
For I = 1 To tb.PivotFields(Champ).PivotItems.Count
    tb.PivotFields(Champ).PivotItems(I).Visible = True
Next
For I = 1 To tb.PivotFields(Champ).PivotItems.Count
    If tb.PivotFields(Champ).PivotItems(I).Name <> V Then tb.PivotFields(Champ).PivotItems(I).Visible = False
Next
 On Error GoTo 0
End Sub

et on l'utilise comme ça dans mon exemple

Code:

1
2
TDC.FiltrePivotTables "FOURNISSEUR", "GEMAR"
TDC.FiltrePivotTables "DATE", "01/07/2014"

29/07/2014, 15h07
zielite

A priori cela ne fonctionne pas, les filtres laissent passer les infos.

Cela est dû au fait que certaines cellules du champ concerné sont vides. Elles passent donc au travers du filtre.

test ça

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Public Sub FiltreTypeFiltre(Champ As String, V As String)
On Error Resume Next
Dim I As Integer
tb.PivotFields(Champ).ClearAllFilters
If IsDate(V) Then tb.PivotFields(Champ).CurrentPage = DateValue(V):  On Error GoTo 0 :Exit Sub
tb.PivotFields(Champ).CurrentPage = CStr("" & V)
 
  On Error GoTo 0 :
End Sub
Public Sub FiltrePivotTables(Champ As String, V As String)
On Error Resume Next
Dim I As Integer
tb.PivotFields(Champ).ClearAllFilters
For I = 1 To tb.PivotFields(Champ).PivotItems.Count
    If tb.PivotFields(Champ).PivotItems(I).Name <> V Then tb.PivotFields(Champ).PivotItems(I).Visible = False
Next
 On Error GoTo 0
End Sub

Code:

1
2
TDC.FiltrePivotTables "FOURNISSEUR", "GEMAR"
TDC.FiltreTypeFiltre "DATE", "01/07/2014"

29/07/2014, 16h11
zielite
Merci encore! J'ai toujours les autres types de motifs qui s'affichent

J'ai rentré le code:
Code:

1 2 TDC.FiltreTypeFiltre "Qualification", "Développement" TDC.FiltreTypeFiltre "Motif", "Commercial"
Par exemple dans la colonne "Qualification", je ne veux que l'item "Développement" et pourtant j'ai d'autres items (pour lesquels il n'y a aucune information dans la colonne "motif") qui apparaissent.

En tout cas merci pour ton aide.
29/07/2014, 16h17
Invité

peux tu me donné un fichier avec de données bidonnées si possible avec ta macro si c'est 1 fichier.xlsm zip le
29/07/2014, 17h05
zielite

1 pièce(s) jointe(s)

Pièce jointe 152247

1 pièce(s) jointe(s)

Bonjour,test ça

fichier joint:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
Dim TDC As New clsTdcRD
Sheets("Data").UsedRange = Sheets("Data").UsedRange.Value
TDC.CreerTableau ActiveWorkbook, "Data!" & Sheets("Data").UsedRange.Address, "TDC", "Data"
TDC.NewPivotTables "Qualification", TypeFiltre
TDC.NewPivotTables "Motif", TypeFiltre
TDC.NewPivotTables "Affecté à", Typeligne
TDC.NewPivotTables "Services", Typeligne
TDC.NewDataField "CA", Somme
TDC.AfficheTotal True, True
TDC.Style PivotStyleMedium9
If TDC.FiltreTypeFiltre("Qualification", "Développement ") = False Then MsgBox "Pastrouvé"
If TDC.FiltreTypeFiltre("Motif", "Commercial ") = False Then MsgBox "Pastrouvé"
End Sub

30/07/2014, 15h22
zielite

Merci INFINIMENT C'est Top!

Si je veux à partir des liens de la feuille "intro" lancer plusieurs trois TCD différents pour les créer sur trois nouvelles feuilles, je créé trois nouvelles macro en copie-collant de ton code et je remplace "TDC" par "TDC2" "TDC3" etc..?
30/07/2014, 15h25
Invité

Oui exactement. sachant que le module de classe serra commun à tous, pas besoin d'y toucher ou de le recopier sous un autre nom!
30/07/2014, 15h45
zielite

Merci beaucoup pour ton temps et ton aide!
30/09/2014, 13h11
zielite

1 pièce(s) jointe(s)

Problème paramétrage de TCD

Je n'arrive pas à te joindre un fichier en message privé, je le poste donc ici.

Merci encore.

dans ton fichier le UsedRange retourne un plage qui n'est pas bonne!
j'ai pris le CurrentRegion !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Zone11Lundi()
Dim TDC As New clsTdcRD
TDC.CreerTableau ActiveWorkbook, "Data!" & Sheets("Data").Range("A1").CurrentRegion.Address, "Test", "Data"
TDC.NewPivotTables "Zone", TypeFiltre
TDC.NewPivotTables "Jour", TypeFiltre
TDC.NewPivotTables "Tournee", Typeligne
TDC.NewPivotTables "Code_PDL", Typeligne
TDC.NewPivotTables "Nom_PDL", Typeligne
TDC.NewPivotTables "Article", Typeligne
TDC.NewDataField "Stock", Somme
TDC.AfficheTotal True, True
TDC.Style PivotStyleMedium9
If TDC.FiltreTypeFiltre("Zone", "11") = False Then MsgBox "Pastrouvé"
If TDC.FiltreTypeFiltre("Jour", "Lun") = False Then MsgBox "Pastrouvé"
End Sub

30/09/2014, 15h20
zielite

Merci rdurupt!