Créer en VB des classeurs contenant des tableaux croisés sur la base d'un modèle

**mikeactuaire** · 31/10/2011, 22h35

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** · 01/11/2011, 12h32

Bonjour,

Regarde la macro ci-dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 17h02

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 17h25

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 17h34

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** · 01/11/2011, 17h42

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

**mikeactuaire** · 01/11/2011, 18h21

Daniel,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 18h22

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** · 01/11/2011, 18h35

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 18h44

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** · 01/11/2011, 18h48

Voici ce qu'il me donne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 18h59

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** · 01/11/2011, 19h10

Voici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

J'ai modifié par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 01/11/2011, 19h24

"DTL TX! & Plage.Address"

Non, il faut mettre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"DTL TX!" & Plage.Address

**mikeactuaire** · 01/11/2011, 19h44

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

**Daniel.C** · 01/11/2011, 19h55

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** · 02/11/2011, 18h27

OK, je l'ai:

Voici le morceau modifier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

ou encore:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 02/11/2011, 18h41

Est-ce que tu peux poster ton code ?

**mikeactuaire** · 02/11/2011, 18h59

Bonjour Daniel,

Le voici:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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