Construire plusieur TCD sur une même feuille

Le 06/07/2015 à 16:03

Bonjour,

J'ai un soucis, je construis plusieurs TCD sur plusieurs pages (à chaque page son tableau) via le vba. et je voudrai les mettre tous sur une meme page.

voici un extrait de mon code, pour deux tableaux croisés par exmple :

Sub MacroTDC0()

'

Dim wshTCD0 As Worksheet

Dim PvtTCD0 As PivotTable

Set wshTCD0 = Worksheets("Generalite")

'Suppression de tous les TCD existants dans la feuille

For Each PvtTCD0 In wshTCD0.PivotTables

PvtTCD0.TableRange2.Clear

Next PvtTCD0

Set PvtTCD0 = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Données!A:CK") _

.CreatePivotTable(TableDestination:=wshTCD0.Range("B5"), TableName:="Generalite")

'Ajout des champs au TCD

With PvtTCD0

'Ajout d'une Colonne puis ajouter "genre" en valeur : .Orientation = xlDataField

With .PivotFields("genre")

.Orientation = xlRowField

.Orientation = xlDataField

.Position = 1

End With

'Ajout d'une Colonne puis ajouter "genre" en valeur : .Orientation = xlDataField

With .PivotFields("nationalite")

.Orientation = xlRowField

.Orientation = xlDataField

.Position = 1

End With

End With

' Supprimer la ligne "(vide)"

For i = 5 To 20

If Sheets("Generalite").Cells(i, 2) = "(vide)" Then

Sheets("Generalite").Cells(i, 2).Select

Selection.Delete Shift:=xlUp

End If

Next i

End Sub

Sub MacroTDC1()

'

'

'

' Diplômés par nationalité

'

'Dimension des variables

Dim wshTCD0 As Worksheet

Dim PvtTCD0 As PivotTable

'Affectation du TCD à la feuille "TCD automatique"

Set wshTCD0 = Worksheets("Generalite")

'Suppression de tous les TCD existants dans la feuille

' For Each PvtTCD0 In wshTCD0.PivotTables

' PvtTCD0.TableRange2.Clear

' Next PvtTCD0

'Ajout d'un TCD sur la feuille "TCD automatique"

Set PvtTCD0 = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Données!A:CK") _

.CreatePivotTable(TableDestination:=wshTCD0.Range("B13"), TableName:="Generalite")

'Ajout des champs au TCD

With PvtTCD0

'Ajout d'une Colonne puis ajouter "genre" en valeur : .Orientation = xlDataField

With .PivotFields("nationalite")

.Orientation = xlRowField

.Orientation = xlDataField

.Position = 1

End With

End With

' Supprimer la ligne "(vide)"

For i = 5 To 20

If Sheets("Generalite").Cells(i, 2) = "(vide)" Then

Sheets("Generalite").Cells(i, 2).Select

Selection.Delete Shift:=xlUp

End If

Next i

End Sub

Je vous remercie d'avance...

Le 06/07/2015 à 17:58

Bonjour,

Je ne sais pas vraiment ce que tu compte faire, mais regarde cette procédure et étudie là.

Sinon, tu joins un fichier à ta demande.

Cdlt.

Option Explicit
Dim wsData As Worksheet, wsPT As Worksheet
Dim rngData As Range
Dim ptCache As PivotCache
Dim pt As PivotTable
Dim i As Byte

Public Sub DEMO()

    Application.ScreenUpdating = False

    Set wsData = Worksheets("Données")
    Set rngData = wsData.Cells(1).CurrentRegion
    Set wsPT = Worksheets("Generalite")
    'Suppression de tous les TCD existants dans la feuille
    For Each pt In wsPT.PivotTables
        pt.TableRange2.Clear
    Next pt

    Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 4)
    Set pt = ptCache.CreatePivotTable(wsPT.Range("B5"), "TCD_1", , 4)
    'Ajout des champs au TCD
    With pt
        .ManualUpdate = True
        'Ajout d'une Colonne puis ajouter "genre" en valeur : .Orientation = xlDataField ???
        With .PivotFields("genre")
            .Orientation = xlDataField
            .Function = xlSum
            .Position = 1
            .NumberFormat = "#,##0"
            .Caption = "genre "
        End With
        'Ajout d'une Colonne puis ajouter "genre" en valeur : .Orientation = xlDataField ???
        With .PivotFields("nationalite")
            .Orientation = xlDataField
            .Function = xlSum
            .Position = 2
            .NumberFormat = "#,##0"
            .Caption = "nationalite "
        End With
        .ManualUpdate = False
    End With

    Set pt = ptCache.CreatePivotTable(wsPT.Range("F5"), "TCD_2", , 4)
    With pt
        .ManualUpdate = True
        ' code
        '
        .ManualUpdate = False
    End With

    ' Supprimer la ligne "(vide)"
    'For i = 5 To 20
        'If wsPT.Cells(i, 2) = "(vide)" Then
            'wsData.Cells(i, 2).Delete Shift:=xlUp
        'End If
    Next i

    Set pt = Nothing
    Set ptCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing

End Sub
Le 06/07/2015 à 23:40

Bonjour Jean-Eric,

C'est exactement ce que je veux, ton code est claire.

Mais quand je compile il y a un message d'errer qui sort :

Erreur d’exécution '13' : Incompatibilité type

Au niveau de Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 4)

je ne sais pas si cela est dû à ma version d'office ?

j'utilise office 2013...

Le 07/07/2015 à 07:11

Bonjour,

Ton profil indique 2010,

Tu peux tenter :

Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 5)
Set pt = ptCache.CreatePivotTable(wsPT.Range("B5"), "TCD_1", , 5)

Mais, je pense que l'erreur provient de rngData, donc de la plage définie par :

Set rngData = wsData.Cells(1).CurrentRegion

Toutes les colonnes doivent comporter un entête (un libellé, titre, ...)

Le 07/07/2015 à 09:19

Bonjour Jean-Eric,

Le problème est au niveau de l'intitulé de mes variables,

je les ai modifiés et toujours avec

Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 4), çà marche 10/10

Je te remercie, bonne journée a toi.

Le 07/07/2015 à 12:11

Salut Jean-Eric,

J'ai finalement tester l'ensemble des données de ma base mais cela gêner toujours le même type d'erreur : Erreur d'exécution '13': Incompatibilité de type.

Pourtant en supprimant toutes les autres colonnes (j'ai juste gardé les 3 colonnes pour essaie : specialite, regime et genre) j'ai arrivé à me gerer bien tous les TCD sur une meme page (comme je veux...Avec une colonne effectif(en nombre) et une autre en pourcentange).

Je vous met l'extrait du code :

Option Explicit

Dim wsData As Worksheet, wsPT As Worksheet

Dim rngData As Range

Dim ptCache As PivotCache

Dim pt As PivotTable

Dim i As Byte

Public Sub TDC1()

'Généralité

Application.ScreenUpdating = False

Set wsData = Worksheets("Données")

Set rngData = wsData.Cells(1).CurrentRegion

Set wsPT = Worksheets("Generalite")

'Suppression de tous les TCD existants dans la feuille

For Each pt In wsPT.PivotTables

pt.TableRange2.Clear

Next pt

With wsPT

Set ptCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, rngData, 4)

'Diplômés par sexe :

Set pt = ptCache.CreatePivotTable(wsPT.Range("B5"), "TCD_1", , 4)

With pt

.ManualUpdate = True

' Effectif ou nombre

With .PivotFields("sexe")

.Orientation = xlRowField

.Orientation = xlDataField

.Position = 1

.Caption = "Effectif genre "

End With

With .PivotFields("sexe")

.Orientation = xlRowField

.Orientation = xlDataField

.Calculation = xlPercentOfColumn

.NumberFormat = "#,##0"

.Position = 1

.Caption = "Pourcentage genre(%) "

End With

.ManualUpdate = False

End With

Set pt = ptCache.CreatePivotTable(wsPT.Range("B15"), "TCD_2", , 4)

With pt

.ManualUpdate = True

'Ajout d'une Colonne puis ajouter "genre" en valeur : .Orientation = xlDataField ???

With .PivotFields("nationalite")

.Orientation = xlRowField

.Orientation = xlDataField

.Position = 1

.NumberFormat = "#,##0"

.Caption = "Effectif "

End With

With .PivotFields("nationalite")

.Orientation = xlRowField

.Orientation = xlDataField

.Calculation = xlPercentOfColumn

.NumberFormat = "#,##0"

.Position = 1

.Caption = "Pourcentage nationalité "

End With

.ManualUpdate = False

End With

Set pt = ptCache.CreatePivotTable(wsPT.Range("F5"), "TCD_3", , 4)

With pt

.ManualUpdate = True

With .PivotFields("regime")

.Orientation = xlRowField

.Orientation = xlDataField

.Position = 1

.NumberFormat = "#,##0"

.Caption = "Effectif "

End With

With .PivotFields("nationalite")

.Orientation = xlRowField

.Orientation = xlDataField

.Calculation = xlPercentOfColumn

.NumberFormat = "#,##0"

.Position = 1

.Caption = "Pourcentage regime "

End With

.ManualUpdate = False

End With

End With

Set pt = Nothing

Set ptCache = Nothing

Set rngData = Nothing

Set wsPT = Nothing: Set wsData = Nothing

End Sub

Le 07/07/2015 à 14:02

Re,

Je crains que tu sois obligé de joindre un fichier anonymisé si nécessaire

en précisant les résultats que tu souhaites.

Cdlt.

Le 07/07/2015 à 16:30

Je met ci-joint une présentation de la sortie que je souhaiterai avoir (feuille "TCD automatique1") dans ce classeur "Traitement", j'ai limité le nombre de colonnes (dans la feuille "Données"), ma base initiale à environ 110 colonnes (donc 110 variables).

et il y a une dizaine de TCD que je souhaite automatiser par feuille....

39traitement.xlsm (54.95 Ko)
Le 08/07/2015 à 09:36

Bonjour,

Sans précisions sur les TCDs à créer, je te propose cette procédure, qui va te créer les TCDs à la volée, en fonction du nombre de colonnes en ligne 1.

Il serait judicieux d'avoir une liste des TCDs à créer...

A tester et à adapter dans ton vrai classeur.

Cdlt.

Option Explicit
'Option Private Module

Public Sub CreatePivotTables()

    With Application
        modeCalc = .Calculation
        .Calculation = xlCalculationManual
        '.EnableEvents = False
        .ScreenUpdating = False
    End With

    Set wb = ThisWorkbook
    With wb
        Set wsData = .Worksheets("Données")
        Set wsPT = .Worksheets("TCD automatique1")
    End With

    For Each pt In wsPT.PivotTables
        pt.TableRange2.Clear
    Next pt

    With wsData
        lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set rngData = .Cells(1).Resize(lastRow, lastCol)
    End With

    Set ptCache = wb.PivotCaches.Create(xlDatabase, rngData, 5)
    ptCount = 1
    r = 3

    For c = 10 To lastCol
        strField = wsData.Cells(1, c)
        Set pt = ptCache.CreatePivotTable(wsPT.Cells(r, 1), "PT_" & ptCount, , 5)
        With pt
            .ManualUpdate = True
            .AddFields RowFields:=Array("regime", "specialite"), _
                    ColumnFields:=wsData.Cells(1, c).Value
            With .PivotFields(strField)
                .Orientation = xlDataField
                .Function = xlCount
                .NumberFormat = "#,##0"
                .Position = 1
                .Caption = "Effectif "
            End With
            With .PivotFields(strField)
                .Orientation = xlDataField
                .Function = xlCount
                .NumberFormat = "0.0%"
                .Caption = "% Effectif"
                .Position = 2
                .Calculation = xlPercentOfRow
            End With
            .RowAxisLayout xlOutlineRow
            .TableStyle2 = "PivotStyleMedium2"
            .ErrorString = "-"
            .DisplayErrorString = True
            .ManualUpdate = False
        End With
        ptCount = ptCount + 1
        r = wsData.Cells(Rows.Count, 1).End(xlUp).Row + 3
    Next c

    With wsPT
        .Activate
        .[A1].Select
    End With

    With Application
        .Calculation = modeCalc
        '.EnableEvents = True
        .ScreenUpdating = True
    End With

    Set pt = Nothing
    Set ptCache = Nothing
    Set rngData = Nothing
    Set wsPT = Nothing: Set wsData = Nothing
    Set wb = Nothing

End Sub
Le 09/07/2015 à 15:23

Bonjour Jean-Eric,

Merci beaucoup, j'ai pu réussir avec le 1er code que tu m'avais envoyer.

Le problème était que mes TCDs sont placés cote à cote mais mais si je les place les uns après les autres çà marche super bien .

Je te remercie.

Bonne journées

Crdlt,

Le 10/07/2015 à 09:20

Bonjour,

Pense à clore le sujet.

Cdlt.

Rechercher des sujets similaires à "construire tcd meme feuille"