[XL-2007] Créer en VB des classeurs contenant des tableaux croisés sur la base d'un modèle [Résolu]

[mikeactuaire]

Bonjour à tous,

J'ai un classeur avec plusieurs clients.

Dans le classeur, se trouve un tableau croisé dynamique (Feuil1) qui utilise la Base de donnée (Feuil2).

Je voudrais créer un classeur pour chacun des clients avec le meme tableau croisé mais en utilisant seulement les Données le concernant.

J'ai utilisé plusieurs méthodes mais je n'abouti pas.

Si qq un a déjà vu ce genre de code merci de m'aider.

A+

[Daniel.C]

Bonjour,

Regarde la macro ci-dessous :

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
Sub test()
'Réf. 111101.xlsm mikeactuaire
Dim Dico As Object, c As Range, Plage As Range
Set Dico = CreateObject("Scripting.Dictionary")
'le classeur "source.xlsm" doit être ouvert au démarrage de la macro
'c'est le classeur qui contient les données à copier
Workbooks("source.xlsm").Activate
'la feuille Feuil2 contient les données du TCD
With Sheets("Feuil2")
    'on élimine les doublons en utilisant un dictionnaire
    For Each c In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
        If Not Dico.exists(c.Value) Then
            Dico.Add c.Value, c.Value
        End If
    Next c
End With
    'boucle sur chaque nom de client
    For Each Item In Dico.items
        'on copie les deux feuilles (données et TCD) dans un classeur vierge
        Sheets(Array("Feuil1", "Feuil2")).Copy
        'on travaille sur le nouveau classeur
        With Sheets("Feuil2")
            'Plage représente les données du TCD. J'ai utilisé les colonnes A et B...
            'à modifier
            Set Plage = .Range(.[A1], .Cells(.Rows.Count, 2).End(xlUp)) 'j'utilise les colonnes A et B
            .[H1] = .[A1]
            .[H2] = Item
            'filtre élaboré en colonne I sur le nom de client
            Plage.AdvancedFilter xlFilterCopy, .[H1:H2], .[I1]
            .[A:B].ClearContents
            'copie du résultat du filtre en colonne A et B
            .[I:J].Cut .[A:B]
            .[H1:H2].ClearContents
            'Plage d=représente les nouvelles données du TCD correspondant au nom de client
            Set Plage = .Range(.[A1], .Cells(.Rows.Count, 2).End(xlUp))
            'on ajuste le TCD à la nouvelle plage de données
            Sheets("Feuil1").PivotTables(1).ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                "Feuil2!" & Plage.Address, Version:=xlPivotTableVersion12)
            'enregistrement du classeur (au format XL97-2003)
            ActiveWorkbook.SaveAs "c:\temp\" & Item, xlExcel8
            ActiveWorkbook.Close
        End With
    Next Item
Set Dico = Nothing
End Sub

[mikeactuaire]

Bonjour Daniel,

Merci pour ton aide.
En fait, j'ai M colonnes mais j'ai pu adapter ceci.

Par contre j'ai une erreur dans ce bout de code:

Code :

1
2
3
4
'on ajuste le TCD à la nouvelle plage de données
            Sheets("Feuil1").PivotTables(1).ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                "Feuil2!" & Plage.Address, Version:=xlPivotTableVersion12)

Voici la boite d'erreur:
Run-time error ......
The pivot Table field name is not valid. To create a Pivot Table report, you must use data that is organized as a list with labeled columns. If you are changing the name of a pivot Table field, you must type a new name for the field.

Et en passant au Debug,

Code :

1
2
3
4
'on ajuste le TCD à la nouvelle plage de données
            Sheets("Feuil1").PivotTables(1).ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase,(xlDatabase=1) SourceData:= _
                "Feuil2!" & Plage.Address (Plage.Address= c'est la bonne plage) , Version:=xlPivotTableVersion12 (xlPivotTableVersion12=3) )

Merci,

[Daniel.C]

Si tes données occupent les colonnes A à M, la ligne 35 devient :

Code :

Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp))

Sinon, quelle est ta version d'Excel, c'est important avec les TCD. Confirme-moi aussi que tu n'as qu'un TCD sur la feuille ou donne-moi son nom.

[mikeactuaire]

OK,

J'ai Excel 2007, et sur cette feuille je n'ai qu'un seul TCD qui est "PivotTable1".

Pour la modification que tu m'as apporté au sujet des colonnes, devrais-je aussi modifier les parties ou se trouvent :.[H1:H2], .[I1] car ils se retrouveront dans les champs?

[Daniel.C]

Affirmatif, décale le tout à partir de la colonne N.

[mikeactuaire]

Daniel,

voici le code ajusté avec mes colonnes, mais il me donne une autre erreur

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
Sub test()
'Réf. 111101.xlsm mikeactuaire
Dim Dico As Object, c As Range, Plage As Range
Set Dico = CreateObject("Scripting.Dictionary")
'le classeur "source.xlsm" doit être ouvert au démarrage de la macro
'c'est le classeur qui contient les données à copier
Workbooks("Test2.xlsm").Activate
'la feuille DTL TX contient les données du TCD
With Sheets("DTL TX")
    'on élimine les doublons en utilisant un dictionnaire
    For Each c In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
        If Not Dico.exists(c.Value) Then
            Dico.Add c.Value, c.Value
        End If
    Next c
End With
    'boucle sur chaque nom de client
    For Each Item In Dico.items
        'on copie les deux feuilles (données et TCD) dans un classeur vierge
        Sheets(Array("Balances", "DTL TX")).Copy
        'on travaille sur le nouveau classeur
        With Sheets("DTL TX")
            'Plage représente les données du TCD. J'ai utilisé les colonnes A à M            
Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp)) 'j'utilise les colonnes A à M
            .[N1] = .[A1]
            .[N2] = Item
            'filtre élaboré en colonne I sur le nom de client
            Plage.AdvancedFilter xlFilterCopy, .[N1:N2], .[O1]
            .[A:M].ClearContents
            'copie du résultat du filtre en colonne A à M           
 .[O:AA].Cut .[A:M]
            .[N1:N2].ClearContents
            'Plage d=représente les nouvelles données du TCD correspondant au nom de client
            Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp))
            'on ajuste le TCD à la nouvelle plage de données
            Sheets("Balances").PivotTables(1).ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                "DTL TX!" & Plage.Address, Version:=xlPivotTableVersion12)
            'enregistrement du classeur (au format XL97-2003)
            ActiveWorkbook.SaveAs "c:\temp\" & Item, xlExcel8
            ActiveWorkbook.Close
        End With
    Next Item
Set Dico = Nothing
End Sub

[Pour ceux qui sont interressés:
DTL TX=Feuil2
Balances= Feuil1]

L'erreur est :

Run-time error '5':
Invalid procedure call or argument

[Daniel.C]

Quelle erreur ? sur quelle ligne ?

Quelle colonne contient le nom des clients ?

L'erreur est :

Run-time error '5':

Invalid procedure call or argument

Est-ce qu'il y a une ligne ou un mot de surligné ?

[mikeactuaire]

C'est bien la colonne A qui contient le nom des clients.

L'erreur est toujours à la meme place:

'on ajuste le TCD à la nouvelle plage de données

Code :

1
2
3
Sheets("Balances").PivotTables(1).ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                "DTL TX!" & Plage.Address, Version:=xlPivotTableVersion12)

Par contre j'obtient bien la création d'un nouveau classeur, avec les deux feuilles et la feuille de la base de données, contient bien toutes les données du premier client filtré.

J'ai trouvé l'erreur en utilisant le DEBUG.

[Daniel.C]

Essaie, en utilisant l'enregistreur de macros, de modifier la plage des données du TCD. Il y a peut-être un différence entre la syntaxe de ta version et la mienne (XL2010).

[mikeactuaire]

Voici ce qu'il me donne:

Code :

1
2
3
4
ActiveSheet.PivotTables("PivotTable2").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "C:\Documents and Settings\Desktop\New Folder\[Test2.xlsm]DTL TX!R1C1:R62798C13" _
        , Version:=xlPivotTableVersion12)

[Daniel.C]

Non, tu dois prendre les données sur la feuille "DTL TX du classeur actif : quand tu copies les deux feuilles, le TCD conserve le lien avec les données du classeur source. Il faut rompre ce lien.

[mikeactuaire]

Voici :

Code :

1
2
3
ActiveSheet.PivotTables("PivotTable2").ChangePivotCache ActiveWorkbook. _
        PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "DTL TX!R1C1:R281C13", Version:=xlPivotTableVersion12)

J'ai modifié par:

Code :

1
2
3
4
Sheets("Balances").PivotTables("PivotTable2").ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                "DTL TX! & Plage.Address", Version:=xlPivotTableVersion12)

Mais ca ne marche toujours pas, je pense qu'il ne reconnait peut etre pas " Plage.Adress" ?

[Daniel.C]

"DTL TX! & Plage.Address"

Non, il faut mettre :

Code :

"DTL TX!" & Plage.Address

[mikeactuaire]

J'avais essayé les deux mais ca ne marche pas...

[Daniel.C]

Est-ce tu pourrais mettre ton classeur en pièce jointe en effaçant les données confidentielles. Au besoin, compacte-le avec winzip ou winrar.

[mikeactuaire]

OK, je l'ai:

Voici le morceau modifier:

Code :

1
2
3
 Sheets("Balances").PivotTables("PivotTable2").ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                 Plage.Address, Version:=xlPivotTableVersion12)

Merci encore à Daniel,

A+


N'oubliez pas de mettre des ==========================================================================================================================>>>>>>>

Réctification,

tout est bon,

A+

Bonjour à tous,

Il reste cependant un petit détail:

Lorsque j'ouvre les nouveau classeurs et que je clique sur le TCD, il y a une erreur qui se produit. Il demande de rafraichir le TCD.

j'ai doncessayé ceci:

Code :

Sheets("Balances").PivotTables("PivotTable1").PivotCache.Refresh

ou encore:

Code :

Sheets("Balances").PivotTables("PivotTable1").RefreshTable

Mais cela ne fonctionne pas.

Il est interressant de noter que tant que le classeur n'a pas été sauvegardé , le TCD est mis à jour, mais lorsque la macro passe à la ligne

Code :

ActiveWorkbook.SaveAs "C:

Aprés ceci, lorsque je clique sur le TCD, j'obtient:

The PivotTable report was saved without the underlying data. Use the Refresh command to update the repot.

[Daniel.C]

Est-ce que tu peux poster ton code ?

[mikeactuaire]

Bonjour Daniel,

Le voici:

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub Macro()
' Keyboard Shortcut: Ctrl+Shift+M
 
Dim Dico As Object, c As Range, Plage As Range
Set Dico = CreateObject("Scripting.Dictionary")
'le classeur "source.xlsm" doit être ouvert au démarrage de la macro
'c'est le classeur qui contient les données à copier
Workbooks("Grants P7 2011-12.xlsm").Activate
'la feuille DTL TX contient les données du TCD
With Sheets("DTL TX")
    'on élimine les doublons en utilisant un dictionnaire
    For Each c In .Range(.[A2], .Cells(.Rows.Count, 1).End(xlUp))
        If Not Dico.exists(c.Value) Then
            Dico.Add c.Value, c.Value
        End If
    Next c
End With
    'boucle sur chaque nom de client
    For Each Item In Dico.items
        'on copie les feuilles (données et TCD) dans un classeur vierge
        Sheets(Array("Balances", "DTL TX", "TX DTL By Dr & Acc", "Total Activity By Period", "CIHR Grouping")).Copy
        'on travaille sur le nouveau classeur
        With Sheets("DTL TX")
            'Plage représente les données du TCD. J'ai utilisé les colonnes A à M
            Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp)) 'j'utilise les colonnes A à M
            .[N1] = .[A1]
            .[N2] = Item
            'filtre élaboré en colonne I sur le nom de client
            Plage.AdvancedFilter xlFilterCopy, .[N1:N2], .[O1]
            .[A:M].ClearContents
            'copie du résultat du filtre en colonne A et B
            .[O:AA].Cut .[A:M]
            .[N1:N2].ClearContents
            'Plage =représente les nouvelles données du TCD correspondant au nom de client
            Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp))
            'on ajuste le TCD à la nouvelle plage de données
             Sheets("TX DTL By Dr & Acc").PivotTables("PivotTable2").ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                Plage.Address, Version:=xlPivotTableVersion12)
 
             Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp))
            Sheets("Balances").PivotTables("PivotTable1").ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                Plage.Address, Version:=xlPivotTableVersion12)
 
 
      Set Plage = .Range(.[A1], .Cells(.Rows.Count, 13).End(xlUp))
             Sheets("Total Activity By Period").PivotTables("PivotTable3").ChangePivotCache _
                ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
                Plage.Address, Version:=xlPivotTableVersion12)
                'ActiveSheet.PivotTables(1).RefreshTable
 
 
 
            'enregistrement du classeur (au format XL07)
                 ActiveWorkbook.SaveAs "C:\Documents and Settings\mmeyer\Desktop\Test\" & Left(Item, 4) & ".xlsx"
 
 
 
           ActiveWorkbook.Close
        End With
    Next Item
Set Dico = Nothing
End Sub

[Daniel.C]

Essaie d'ajouter :

Code :

ActiveWorkbook.RefreshAll

avant la sauvegarde.