[VBA/Excel] macro qui générent plusieurs TCD

Le 14/05/2010 à 11:25

Bonjour,

j'ai beau chercher depuis 1 semaine, mais pour l'instant en vain.

j'aimerais développer ( un bien grand mot) une macro qui à partir d'une base de donnée constituée sur un fichier excel ( je précise xl2003) génèrerait 5 tableaux Croisés Dynamiques sur dans un autre fichier et tous les 5 sur la même feuille

( ces tableaux ne font que 2 lignes donc pas de soucis de place).

j'ai utilisé l'enregistreur de macro mais impossible relancer ce qui est enregistré.

je fait un copié/collé de mon "malheureux" code.

si vous pouviez me donner un coup de main ce serait royal

Merci d'avance

---------

Workbooks.Add
     ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "[macro_0405.xls]controle!R1C1:R828C20" ).CreatePivotTable TableDestination:= _
        "", TableName:="Tableau croisé dynamique1", _
        DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique1" ).ColumnGrand = False
    ActiveSheet.PivotTables("Tableau croisé dynamique1" ).AddFields RowFields:= _
        "contrôle_famille", ColumnFields:="Créateur"
    With ActiveSheet.PivotTables("Tableau croisé dynamique1" ).PivotFields("ID" )
        .Orientation = xlDataField
        .Caption = "Nombre de ID"
        .Function = xlCount
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1" ).PivotFields( _
        "contrôle_famille" )
        .PivotItems("ok" ).Visible = False
        .PivotItems("#N/A" ).Visible = False
    End With
    Range("A8" ).Select
    ActiveWorkbook.Worksheets("Classeur2" ).PivotTables("Tableau croisé dynamique1" ). _
        PivotCache.CreatePivotTable TableDestination:="[Classeur2]Feuil1!R8C1", _
        TableName:="Tableau croisé dynamique4", DefaultVersion:= _
        xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique4" ).ColumnGrand = False
    ActiveSheet.PivotTables("Tableau croisé dynamique4" ).AddFields RowFields:= _
        "contrôle_thême", ColumnFields:="Créateur"
    With ActiveSheet.PivotTables("Tableau croisé dynamique4" ).PivotFields("ID" )
        .Orientation = xlDataField
        .Caption = "Nombre de ID"
        .Function = xlCount
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique4" ).PivotFields( _
        "contrôle_thême" )
        .PivotItems("ok" ).Visible = False
        .PivotItems("#N/A" ).Visible = False
    End With
    Range("A13" ).Select
    ActiveWorkbook.Worksheets("Feuil1" ).PivotTables("Tableau croisé dynamique1" ). _
        PivotCache.CreatePivotTable TableDestination:="[Classeur2]Feuil1!R13C1", _
        TableName:="Tableau croisé dynamique5", DefaultVersion:= _
        xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique5" ).ColumnGrand = False
    ActiveSheet.PivotTables("Tableau croisé dynamique5" ).AddFields RowFields:= _
        "contrôle_sous-thême", ColumnFields:="Créateur"
    With ActiveSheet.PivotTables("Tableau croisé dynamique5" ).PivotFields("ID" )
        .Orientation = xlDataField
        .Caption = "Nombre de ID"
        .Function = xlCount
    End With
    Range("A15" ).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique5" ).PivotFields( _
        "contrôle_sous-thême" )
        .PivotItems("ok" ).Visible = False
        .PivotItems("#N/A" ).Visible = False
    End With
    Range("A18" ).Select
    ActiveWorkbook.Worksheets("Feuil1" ).PivotTables("Tableau croisé dynamique3" ). _
        PivotCache.CreatePivotTable TableDestination:="[Classeur2]Feuil1!R18C1", _
        TableName:="Tableau croisé dynamique6", DefaultVersion:= _
        xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique6" ).ColumnGrand = False
    ActiveSheet.PivotTables("Tableau croisé dynamique6" ).AddFields RowFields:= _
        "contrôle_codefin", ColumnFields:="Créateur"
    With ActiveSheet.PivotTables("Tableau croisé dynamique6" ).PivotFields("ID" )
        .Orientation = xlDataField
        .Caption = "Nombre de ID"
        .Function = xlCount
    End With
    Range("A21" ).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique6" ).PivotFields( _
        "contrôle_codefin" )
        .PivotItems("ok" ).Visible = False
        .PivotItems("#N/A" ).Visible = False
    End With
    Range("A23" ).Select
    ActiveWorkbook.Worksheets("Feuil1" ).PivotTables("Tableau croisé dynamique3" ). _
        PivotCache.CreatePivotTable TableDestination:="[Classeur2]Feuil1!R23C1", _
        TableName:="Tableau croisé dynamique7", DefaultVersion:= _
        xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique7" ).ColumnGrand = False
    ActiveSheet.PivotTables("Tableau croisé dynamique7" ).AddFields RowFields:= _
        "contrôle_cause", ColumnFields:="Créateur"
    With ActiveSheet.PivotTables("Tableau croisé dynamique7" ).PivotFields("ID" )
        .Orientation = xlDataField
        .Caption = "Nombre de ID"
        .Function = xlCount
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique7" ).PivotFields( _
        "contrôle_cause" )
        .PivotItems("ok" ).Visible = False
        .PivotItems("#N/A" ).Visible = False
    End With
    Range("A28" ).Select
    ActiveWorkbook.Worksheets("Feuil1" ).PivotTables("Tableau croisé dynamique3" ). _
        PivotCache.CreatePivotTable TableDestination:="[Classeur2]Feuil1!R28C1", _
        TableName:="Tableau croisé dynamique8", DefaultVersion:= _
        xlPivotTableVersion10
    ActiveSheet.PivotTables("Tableau croisé dynamique8" ).ColumnGrand = False
    ActiveSheet.PivotTables("Tableau croisé dynamique8" ).AddFields RowFields:= _
        "contrôle_sous-cause", ColumnFields:="Créateur"
    With ActiveSheet.PivotTables("Tableau croisé dynamique8" ).PivotFields("ID" )
        .Orientation = xlDataField
        .Caption = "Nombre de ID"
        .Function = xlCount
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique8" ).PivotFields( _
        "contrôle_sous-cause" )
        .PivotItems("ok" ).Visible = False
        .PivotItems("#N/A" ).Visible = False
    End With
    Range("E1" ).Select
    ActiveCell.FormulaR1C1 = "Rapports de Tableaux croisés dynamique"
    Range("D36" ).Select
End Sub
Le 14/05/2010 à 11:37

Bonjour,

Mets ton fichier en ligne sinon pas possible de te donner une solution valable surtout avec les TCD.

Amicalement

Le 14/05/2010 à 16:55

Bonjour,

d'abord merci pour le coup de main

je joins le fichier.

petites précisions:

  • dans l'onglet macro, je lance une macro qui crée un onglet "controle" qui servira de base à la 2è macro qui doit ( si ça marche) lancer le fichier avec les TCD.
  • j'ai du me limiter aux 500 premières lignes pour pouvoir le mettre en ligne

Merci

98macro-0405.zip (119.12 Ko)
Le 14/05/2010 à 17:56

re,

Pour faire plus rapide, explique moi quel est le but de la macro contrôle ??? Tu dupliques la feuille fiche brutes en quelque sorte ?

A te relire

Edit : Autre question : le nombre de lignes dans les feuilles Brutes et corrigées est toujours identiques ou peut être différent ?

Le 14/05/2010 à 23:37

re,

Bon j'ai essayé de comprendre ton fichier. Essaie de voir avec ce code qui va déjà créer les TCD dans une nouvelle feuille dans le même classeur. Si ok, je te donnerai les infos pour la suite.

Sub TCDDan()
'Macro modifiée par Dan pour Greatdevil le 14/05/2010 - XL Pratique
'http://forum.excel-pratique.com/excel/macro-qui-generent-plusieurs-tcd-t17229.html

Dim Plage As Range
Dim lig As Integer
Worksheets.Add
With Sheets("Controle")
    Set PlageTCD = .UsedRange
    .PivotTableWizard SourceType:=xlDatabase, SourceData:=PlageTCD, TableDestination:=Range("A3"), TableName:="TCD1"
End With
With ActiveSheet.PivotTables("TCD1")
    .AddFields RowFields:=Array("contrôle_famille"), ColumnFields:="Créateur"
    .PivotFields("Thème").Orientation = xlDataField
    .ColumnGrand = False
        With .PivotFields("ID")
            .Orientation = xlDataField
            '.Caption = "Nombre de ID"
             .Function = xlCount
        End With
        With .PivotFields("contrôle_famille")
             .PivotItems("ok").Visible = False
             .PivotItems("#N/A").Visible = False
        End With
End With

lig = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5
Range("A" & lig).Select
ActiveSheet.PivotTableWizard SourceType:=xlPivotTable, SourceData:="TCD1", TableDestination:=Cells(lig, 1), TableName:="TCD2"
With ActiveSheet.PivotTables("TCD2")
    .AddFields RowFields:=Array("contrôle_thême"), ColumnFields:="Créateur"
    .PivotFields("Thème").Orientation = xlDataField
    .ColumnGrand = False
        With .PivotFields("ID")
            .Orientation = xlDataField
            '.Caption = "Nombre de ID"
             .Function = xlCount
        End With
        With .PivotFields("contrôle_thême")
             .PivotItems("ok").Visible = False
             .PivotItems("#N/A").Visible = False
        End With
End With

lig = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5
Range("A" & lig).Select
ActiveSheet.PivotTableWizard SourceType:=xlPivotTable, SourceData:="TCD1", TableDestination:=Cells(lig, 1), TableName:="TCD3"
With ActiveSheet.PivotTables("TCD3")
    .AddFields RowFields:=Array("contrôle_sous-thême"), ColumnFields:="Créateur"
    .PivotFields("Thème").Orientation = xlDataField
    .ColumnGrand = False
        With .PivotFields("ID")
            .Orientation = xlDataField
            '.Caption = "Nombre de ID"
             .Function = xlCount
        End With
        With .PivotFields("contrôle_sous-thême")
             .PivotItems("ok").Visible = False
             .PivotItems("#N/A").Visible = False
        End With
End With

lig = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5

Range("A" & lig).Select
ActiveSheet.PivotTableWizard SourceType:=xlPivotTable, SourceData:="TCD1", TableDestination:=Cells(lig, 1), TableName:="TCD4"
With ActiveSheet.PivotTables("TCD4")
    .AddFields RowFields:=Array("contrôle_codefin"), ColumnFields:="Créateur"
    .PivotFields("Thème").Orientation = xlDataField
    .ColumnGrand = False
        With .PivotFields("ID")
            .Orientation = xlDataField
            '.Caption = "Nombre de ID"
             .Function = xlCount
        End With
        With .PivotFields("contrôle_codefin")
             .PivotItems("ok").Visible = False
             .PivotItems("#N/A").Visible = False
        End With
End With

lig = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5
Range("A" & lig).Select
ActiveSheet.PivotTableWizard SourceType:=xlPivotTable, SourceData:="TCD1", TableDestination:=Cells(lig, 1), TableName:="TCD5"
With ActiveSheet.PivotTables("TCD5")
    .AddFields RowFields:=Array("contrôle_cause"), ColumnFields:="Créateur"
    .PivotFields("Thème").Orientation = xlDataField
    .ColumnGrand = False
        With .PivotFields("ID")
            .Orientation = xlDataField
            '.Caption = "Nombre de ID"
             .Function = xlCount
        End With
        With .PivotFields("contrôle_cause")
             .PivotItems("ok").Visible = False
             .PivotItems("#N/A").Visible = False
        End With
End With

lig = ActiveSheet.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 5
Range("A" & lig).Select
ActiveSheet.PivotTableWizard SourceType:=xlPivotTable, SourceData:="TCD1", TableDestination:=Cells(lig, 1), TableName:="TCD6"
With ActiveSheet.PivotTables("TCD6")
    .AddFields RowFields:=Array("contrôle_sous-cause"), ColumnFields:="Créateur"
    .PivotFields("Thème").Orientation = xlDataField
    .ColumnGrand = False
        With .PivotFields("ID")
            .Orientation = xlDataField
            '.Caption = "Nombre de ID"
             .Function = xlCount
        End With
        With .PivotFields("contrôle_sous-cause")
             .PivotItems("ok").Visible = False
             .PivotItems("#N/A").Visible = False
        End With
End With
Range("E1") = "Rapports de Tableaux croisés dynamique"
End Sub

A te relire

Le 15/05/2010 à 18:02

bonjour Dan

merci de te préoccuper de mon problème

dèjà pour répondre à tes questions:

explique moi quel est le but de la macro contrôle ??? Tu dupliques la feuille fiche brutes en quelque sorte?

pour faire simple, l'onglet fiches brutes recense les annotations d'utilisateurs initiaux. puis il ya une étape de correction où des correcteurs vont modifier les 1eres annotations (celles qui sont erronées) . le but en comparant les onglets "brutes" et "corrigée" faire ressortir les différences (donc erreurs) pour sensibiliser l'utilisateur initial sur celles qu'il répète souvent.

Autre question : le nombre de lignes dans les feuilles Brutes et corrigées est toujours identiques ou peut être différent ?

pas nécessairement. mais vu que je pars de l'onglet contrôle comme source de mes tcd, je m'en occupe pas.

je regarde ton code et te tient au courant

Bon week end

Le 15/05/2010 à 19:22

re,

pas nécessairement. mais vu que je pars de l'onglet contrôle....

Je t'ai posé cette question car j'ai aussi refait la macro qui construit la feuille controle afin qu'elle s'exécute plus vite.

Dès que ce sera ok pour les TCD, je posterai ce code et ajouterai les instructions dans la macro TCD pour que la feuille TCD soit placée dans un nouveau classeur comme tu le faisais dans ton code.

A te relire

Le 16/05/2010 à 10:10

Bonjour Dan,

ta macro tourne à merveille, j'ai juste retiré une ligne code au niveau des TCD afin de n'avoir que la ligne "nombre ID" sans avoir la ligne "Thème" chaque fois.

la macro qui construit la feuille contrôle est un mixte de l'enregistreur et de formules excel ( vlookup), c'est vraiment cool qu'en plus de m'aider pour les TCD que tu optimise la 1ère macro

en tout cas, chapeau bas

Le 16/05/2010 à 10:34

Re,

voici le code de la macro 1 que j'ai appelée "Controle".

Sub Controle()
'Macro modifiée par Dan pour Greatdevil le 14/05/2010 - XL Pratique
'http://forum.excel-pratique.com/excel/macro-qui-generent-plusieurs-tcd-t17229.html

Dim dlig As Integer
dlig = Worksheets("fiches brutes").Range("A" & Rows.Count).End(xlUp).Row

Sheets("fiches corrigées").UsedRange.Name = "Plage"
Application.ScreenUpdating = False
Worksheets.Add after:=Worksheets(Worksheets.Count - 1)

With ActiveSheet
  .Name = "controle"
  Worksheets("fiches brutes").Columns("A:A").Copy .Range("A1")
  Worksheets("fiches brutes").Columns("d:d").Copy .Range("t1")

    ' auto remplissage
  Dim NumCol As Integer, NumColBis As Integer
    NumColBis = 2
    For NumCol = 10 To 15
        Sheets("fiches brutes").Columns(NumCol).Copy .Cells(1, NumColBis)
        NumColBis = NumColBis + 3
    Next NumCol

   'colonne famille
    .Range("C1") = "famille_corrigé"
    .Range("C2") = "=VLOOKUP(RC[-2],Plage,10,FALSE)"
    .Range("C2").AutoFill Destination:=.Range("C2:C" & dlig)
    .Range("D1") = "contrôle_famille"
    .Range("D2") = "=IF(RC[-2]=RC[-1],""ok"",""corrigé"")"
    .Range("D2").AutoFill Destination:=.Range("D2:D" & dlig)

    'colonne Thême
    .Range("f1") = "Thême_corrigé"
    .Range("f2") = "=VLOOKUP(RC[-5],Plage,11,FALSE)"
    .Range("F2").AutoFill Destination:=.Range("F2:F" & dlig)
    .Range("G1") = "contrôle_thême"
    .Range("G2") = "=IF(RC[-2]=RC[-1],""ok"",""corrigé"")"
    .Range("G2").AutoFill Destination:=.Range("G2:G" & dlig)

    'colonne Sous-Thême
    .Range("i1") = "Sous-Thême_corrigé"
    .Range("i2") = "=VLOOKUP(RC[-8],Plage,12,FALSE)"
    .Range("i2").AutoFill Destination:=.Range("i2:i" & dlig)
    .Range("j1") = "contrôle_sous-thême"
    .Range("j2") = "=IF(RC[-2]=RC[-1],""ok"",""corrigé"")"
    .Range("j2").AutoFill Destination:=.Range("j2:j" & dlig)

     'colonne Codefin
    .Range("l1") = "Codefin_corrigé"
    .Range("l2") = "=VLOOKUP(RC[-11],Plage,13,FALSE)"
    .Range("l2").AutoFill Destination:=.Range("l2:l" & dlig)
    .Range("m1") = "contrôle_codefin"
    .Range("m2") = "=IF(RC[-2]=RC[-1],""ok"",""corrigé"")"
    .Range("m2").AutoFill Destination:=.Range("m2:m" & dlig)

     'colonne Cause
    .Range("o1") = "Cause_corrigé"
    .Range("o2") = "=VLOOKUP(RC[-14],Plage,14,FALSE)"
    .Range("o2").AutoFill Destination:=.Range("o2:o" & dlig)
    .Range("p1") = "contrôle_cause"
    .Range("p2") = "=IF(RC[-2]=RC[-1],""ok"",""corrigé"")"
    .Range("p2").AutoFill Destination:=.Range("p2:p" & dlig)

     'colonne Sous-Cause
    .Range("r1") = "Sous-Cause_corrigé"
    .Range("r2") = "=VLOOKUP(RC[-17],Plage,15,FALSE)"
    .Range("r2").AutoFill Destination:=.Range("r2:r" & dlig)
    .Range("s1") = "contrôle_sous-cause"
    .Range("s2") = "=IF(RC[-2]=RC[-1],""ok"",""corrigé"")"
    .Range("s2").AutoFill Destination:=.Range("s2:s" & dlig)
    End With
End Sub

Si tu le veux tu peux appeler la macro CONTROLE de celle du TCD avec cette instruction --> Call Controle.

A te relire

Si terminé, n'oublie pas de cloturer le fil en cliquant sur le V en vert à coté du bouton Editer.

Le 16/05/2010 à 13:30

Cool,

une dernière petite chose, tu n'as pas rajouter le code qui permet de générer les TCD dans un autre fichier

j'espère ne pas abuser, tu as déjà fait beaucoup

P.S: c'est tellement cool ce que tu as fait, je me permettrai si tu le permets, de mettre le lien de cette discussion dans d'autres forum histoire que cela serve à pas mal de monde

Le 16/05/2010 à 16:41

Re,

une dernière petite chose, tu n'as pas rajouter le code qui permet de générer les TCD dans un autre fichier

Je te suggère autrement. Le TCD est créé dans le fichier où se trouve ton code SUB TCD.

Ensuite on déplace la feuille dans un nouveau classeur avec l'instruction ci-dessous que tu vas rajouter en fin de ta macro SUB TCDDan et ce, juste avant le END SUB

Activesheet.move

Améliorations à voir :

  • peut être de couper les liaisons avec le fichier où se trouve le code car actuellement les TCD seront toujours liés à la base de données de la feuille Controle.
  • supprimer la feuille controle lorsque les TCD sont générés.

A te relire

Le 16/05/2010 à 17:21

hum pas mal ton idée.

je comptais faire des graphiques ou d'autres manip. du genre pour chaque utilisateur faire ressortir où il fait le plus d'erreur afin de cibler où il devra renforcer sa formation....

Pour ce qui est de la question initiale, je suis plus que satisfait des réponses ; je vais donc clôturer ce fil ce soir ( je le laisse ouvert encore un peu au cas où quelqu'un aurait des questions)

Encore merci et bonne fin de week-end

Rechercher des sujets similaires à "vba macro qui generent tcd"