libération d'équation et mise à jour de tableau croisé dynamique

**ligis** · 11/05/2017, 11h46

Bonjour les experts vba,
J'ai besoin de votre expertise.
Je voudrais rendre dynamique un travail mensuel.
Je reçois un Excel de Business Object avec des équations dans des cellules en format texte.
le travail est de:
1- Regrouper dans un même fichier (avec des TCD) le fichier actuel, celui du mois passé et celui du 6 mois passés.
2- Libérer les équations (equations avec collones parfois nomées, et parfois avec adresse de cellule).
3- Mettre à jour les tableaux TCD (feuille TCDs) et la table (N3,O6). La mise à jour de la source du tableau qui peut changer et avoir plus de colonnes et lignes...

J'ai crée 3 boutons chacun correspond à une action.

Le probléme c'est que la mise à jour des tableaux TCD ne fonctionne pas ni le changement de source ni l'actualisation.
Voici mon code (à mon simple niveau) et j'ai joint ke fichier de regroupement en ésperant que vous avez des idées de correction et de simplification. MERCI BEAUCOUP.

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
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
Private Sub CommandButton22_Click()
 
    Dim Wkb1 As Workbook, WkbDest As Workbook, Wkb2 As Workbook, Wkb3 As Workbook
    Dim ws As Worksheet
 
 
    Application.ScreenUpdating = False
    Set Wkb1 = Workbooks.Open(Filename:=Range("P3").Value)  ' LA CELLULE P3 CONTIENT LE LIEN VERS LA SOURCE
 
    Set WkbDest = ThisWorkbook
 
    Wkb1.Sheets("LIST1").Range("A:XFD").Copy WkbDest.Sheets("LIST1").Range("A1")
    WkbDest.Sheets("LIST1").Columns("A:XFD").EntireColumn.AutoFit
    Wkb1.Sheets("LIST2").Range("A:XFD").Copy WkbDest.Sheets("LIST2").Range("A1")
    WkbDest.Sheets("LIST2").Columns("A:XFD").EntireColumn.AutoFit
    WkbDest.Save
    Wkb1.Close
 
    Set Wkb2 = Workbooks.Open(Filename:=Range("P4").Value) ' LA CELLULE P4 CONTIENT LE LIEN VERS LA SOURCE DU MOIS PASSE
 
    Wkb2.Sheets("LIST1").Range("A:XFD").Copy WkbDest.Sheets("LIST1_MOIS_PASSE").Range("A1")
    WkbDest.Sheets("LIST1_MOIS_PASSE").Columns("A:XFD").EntireColumn.AutoFit
    Wkb2.Sheets("LIST2").Range("A:XFD").Copy WkbDest.Sheets("LIST2_MOIS_PASSE").Range("A1")
    WkbDest.Sheets("LIST2_MOIS_PASSE").Columns("A:XFD").EntireColumn.AutoFit
 
    WkbDest.Save
    Wkb2.Close
 
    Set Wkb3 = Workbooks.Open(Filename:=Range("P5").Value) ' LA CELLULE P5 CONTIENT LE LIEN VERS LA SOURCE DU 6 MOIS PASSE
 
    Wkb2.Sheets("LIST1").Range("A:XFD").Copy WkbDest.Sheets("LIST1_6MOIS_PASSE").Range("A1")
    WkbDest.Sheets("LIST1_6MOIS_PASSE").Columns("A:XFD").EntireColumn.AutoFit
    Wkb2.Sheets("LIST2").Range("A:XFD").Copy WkbDest.Sheets("LIST2_6MOIS_PASSE").Range("A1")
    WkbDest.Sheets("LIST2_6MOIS_PASSE").Columns("A:XFD").EntireColumn.AutoFit
 
    WkbDest.Save
    Wkb3.Close
    Application.ScreenUpdating = True
 
 
   ' NOMINATION DES COLONNES
 
    WkbDest.Sheets("LIST1").Select
    ActiveWorkbook.Names.Add Name:="validation_date_last", _
        RefersToR1C1:="=last dashboard!C4"
    ActiveWorkbook.Names.Add Name:="Deadline_date", _
        RefersToR1C1:="=last dashboard!C7"      
 
 
    WkbDest.Save
    Set WkbDest = Nothing
    Set Wkb1 = Nothing
    Set Wkb2 = Nothing
    Set Wkb3 = Nothing
 
 
 
' CODE DU BOUTON QUI RELACHE LES EQUATIONS
 
  Dim nbLignes As Long
  Dim nbLvar As Long
  Dim Data_sht As Worksheet
  Dim Pivot_sht As Worksheet
  Dim StartPoint As Range
  Dim DataRange As Range
  Dim PivotName As String
  Dim NewRange As String
 
 
 
   Sheets("LIST1").Select
     nbLignes = 0
    Range("A1").Select
        Do While ActiveCell.Value <> ""
        nbLignes = nbLignes + 1
        ActiveCell.Offset(1, 0).Select
        Loop
 
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=validation_date_last+365"
 
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(date_Deadline<TODAY();"Yes";"No")"
 
 
 
   Sheets("LIST2").Select
     nbLignes = 0
    Range("A1").Select
        Do While ActiveCell.Value <> ""
        nbLignes = nbLignes + 1
        ActiveCell.Offset(1, 0).Select
        Loop   
 
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(C2>=2;D2>=50000);"Warning";"")"
 
 
 
' CODE BOUTON REFRESH DES TABLES CROISEES DYAMOQUES
 
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
 
 
 
Set Data_sht = ThisWorkbook.Worksheets("LIST1")
 
  PivotName = "PivotTable2"
 
  Set StartPoint = Data_sht.Range("A1")
  Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
 
  NewRange = Data_sht.Name & "!" & _
  DataRange.Address(ReferenceStyle:=xlR1C1)
 
 
'CHANGER LA SOURCE DE LA TABLE
 Pivot_sht.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)
 
'Ensure Pivot Table is Refreshed
  Pivot_sht.PivotTables(PivotName).RefreshTable
 
 
 
Set Data_sht = ThisWorkbook.Worksheets("LIST1_MOIS_PASSE")
 
  PivotName = "PivotTable3"
 
  Set StartPoint = Data_sht.Range("A1")
  Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
 
  NewRange = Data_sht.Name & "!" & _
  DataRange.Address(ReferenceStyle:=xlR1C1)
 
 
'CHANGER LA SOURCE DE LA TABLE
 Pivot_sht.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)
 
'Ensure Pivot Table is Refreshed
  Pivot_sht.PivotTables(PivotName).RefreshTable
 
 
Set Data_sht = ThisWorkbook.Worksheets("LIST1_6MOIS_PASSE")
 
  PivotName = "PivotTable4"
 
  Set StartPoint = Data_sht.Range("A1")
  Set DataRange = Data_sht.Range(StartPoint, StartPoint.SpecialCells(xlLastCell))
 
  NewRange = Data_sht.Name & "!" & _
  DataRange.Address(ReferenceStyle:=xlR1C1)
 
 
'CHANGER LA SOURCE DE LA TABLE
 Pivot_sht.PivotTables(PivotName).ChangePivotCache _
    ThisWorkbook.PivotCaches.Create( _
    SourceType:=xlDatabase, _
    SourceData:=NewRange)
 
'Ensure Pivot Table is Refreshed
  Pivot_sht.PivotTables(PivotName).RefreshTable
 
End Sub

**riaolle** · 11/05/2017, 13h52

Bonjour et bienvenue au forum !

Conformément aux règles du forum : peux-tu baliser ton code, stp (surligner le code, puis appuyer sur le bouton #)? Cela facilite la lecture. Ne transmets tout ton code, mais la partie qui concerne le problème en nous indiquant bien sur quelle ligne tu obtiens un problème. Précise bien quel est le problème (donne-nous le message d'erreur, s'il y en a un).Ne joins pas de fichier, mais explique ton problème et le contexte. Joins éventuellement des copies d'écrans, si nécessaire.

Dans ton code : évite d'utiliser Select/Selection/Activate/ActiveSheet. Précise clairement sur quel objet tu veux travailler. Par ex. :

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

1
2
3
Range("G2").Select ActiveCell.FormulaR1C1 = _ "=IF(AND(C2>=2;D2>=50000);"Warning";"")"

Mais :

Code :

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

Range("G2").FormulaR1C1 = "=IF(AND(C2>=2;D2>=50000);"Warning";"")"

Que veux-tu faire ici?

Code :

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

1
2
3
4
5
6
7
Sheets("LIST1").Select
 nbLignes = 0
 Range("A1").Select
 Do While ActiveCell.Value <> ""
 nbLignes = nbLignes + 1
 ActiveCell.Offset(1, 0).Select
 Loop

Trouver la ligne de la première cellule vide? Il y a plus simple, plus rapide et plus efficace (et sans Select/ActiveCell ...):

Code :

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

nbLignes = Sheets("LIST1").Range("A1").End(xlDown).Row

As-tu utilisé l'enregistreur de macro pour connaître le code associé au changement de plage source et à l'actualisation?
Actualisation --> essaie :

Code :

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

ThisWorkbook.RefreshAll

**ligis** · 15/05/2017, 15h21

Merci riaolle pour ta réaction et tes conseils/simplifications.

Mon problème c'est l'actualisation des tables TCD qui ne fonctionne pas .
le 'ThisWorkbook.RefreshAll' non plus.

Ce dernier code comme pour le mien semble ne pas faire d'actualisation effective des données (càd changer la table)
mais uniquement un refresh.

**ligis** · 17/05/2017, 01h14

aucune idée de solution du problème de changement de table de données du TCD???

libération d'équation et mise à jour de tableau croisé dynamique

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager