Discussion :

[joe.levrai]

Bonjour,

voici un exemple proposé hier sur un autre sujet, qui modifie le cache d'un TCD

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub toto()
Dim Pvt As PivotTable
Dim MaPlage As Range
 
Set MaPlage = Range("A1", "A1000") ' adapte
Set Pvt = ActiveSheet.PivotTables(1)
Pvt.ChangePivotCache _
ActiveWorkbook.PivotCaches.Create(xlDatabase, _
                                  MaPlage, _
                                  Version:=4) ' 3 = 2007, 4 = 2010
End Sub

Dans la mesure où ton cache est lié à 50 TCD, je ne saurai te dire si changer le cache ainsi affectera tes 50 TCD (après les avoir rafraichis)

je te laisse tester et nous dire ce qu'il en est ?

[bil_home]

je crois avoir trouvé une solution. le traitement prend 4 min. il y a 3 codes :
le 1er permet de rafraîchir le cache
le 2eme permet de créer un nouveau cache sur le tcd de controle
le 3eme est le code fourni par vous pour n'avoir qu'un cache.
le 1er code dure un peu moins de 4 min et les 2 autres sont très rapide.
ma démarche est elle correct ou il y a des partie inutile ?
à la sortie de ces programmes mon tcd de controle n'a plus l'option enregistrer les données source... bizarre
(pour rappel seul mon tcd de controle possède l'option enregistrer les données sources)

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
Sub test3()
Dim Pvt As PivotTable
Dim Sh As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Sh In ActiveWorkbook.Worksheets
  For Each Pvt In Sh.PivotTables
   Pvt.PivotCache.Refresh
Next Pvt
Next Sh
Call test4
 Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
End Sub

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
Sub test4()
Dim Pvt As PivotTable
Dim Sh As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
 
nbligrep = Sheets("Reponse").Cells(Rows.Count, 1).End(xlUp).Row
nbcolrep = Sheets("Reponse").Cells(1, Columns.Count).End(xlToLeft).Column
 
 
Sheets("tcd_control").PivotTables("tcd_control").ChangePivotCache ActiveWorkbook. _
  PivotCaches.Create(SourceType:=xlDatabase, SourceData:="reponse!R1C1:R" & nbligrep & "C" & nbcolrep)
 
  For Each PivotCache In ActiveWorkbook.PivotCaches
PivotCache.Refresh
Next
 
ActiveWorkbook.RefreshAll
 
Call ReunionPvtCache
 
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub ReunionPvtCache()
 
Dim Pvt As PivotTable
Dim Sh As Worksheet
 
For Each Sh In ActiveWorkbook.Worksheets
  For Each Pvt In Sh.PivotTables
      Pvt.CacheIndex = Sheets("tcd_Control").PivotTables(1).CacheIndex
  Next Pvt
Next Sh
 
End Sub

[bil_home]

bonjour;
je reviens vers vous car jai modifier le test 4 comme ceci en mettant currentregion. je n'utilise plus test3 qui prenait 4 min de traitement. et là ça marche toujours. du coup pouvez vous me dire l'utilité de la garder ?
initialement je lançais le code test 3 test 4 puis remov_dup. maintenant je ne lance que le test et ermov_dup

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
Sub test4()
Dim Pvt As PivotTable
Dim Sh As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
 
 
Sheets("tcd_control").PivotTables("tcd_control").ChangePivotCache ActiveWorkbook. _
  PivotCaches.Create(SourceType:=xlDatabase, SourceData:="reponse!" & Worksheets("reponse").Range("A1").CurrentRegion.Address)
 
  For Each PivotCache In ActiveWorkbook.PivotCaches
PivotCache.Refresh
Next
Sheets("tcd_control").PivotTables("tcd_control").SaveData = True
ActiveWorkbook.RefreshAll
 
Call remove_dup
 
End Sub
Sub remov_dup()
 
Dim Pvt As PivotTable
Dim Sh As Worksheet
 
For Each Sh In ActiveWorkbook.Worksheets
  For Each Pvt In Sh.PivotTables
      Pvt.CacheIndex = Sheets("tcd_Control").PivotTables(1).CacheIndex
  Next Pvt
Next Sh
 
End Sub

le code test 3

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
Sub test3()
Dim Pvt As PivotTable
Dim Sh As Worksheet
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each Sh In ActiveWorkbook.Worksheets
  For Each Pvt In Sh.PivotTables
   Pvt.PivotCache.Refresh
Next Pvt
Next Sh
'Call test4
 Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
 
End Sub

merci par avance