TCD et etiquette qui disparaisse lors d'un refresh

**DaD92** · 06/03/2012, 10h09

Salut,

Plutôt nub en macro, j'aurais besoin d'un coup de main pour trouver la soluce à un petit soucis.

Dans une macro j'ai :
1 onglet contenant des données (mise à jour par la macro)
1 onglet avec un TCD, lui aussi mis à jour par la macro.

Je me sert du code suivant pour rafraichir le TCD :

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
 
'Calcul de la dernière ligne (onglet dépot)
    Sheets("Depot DATA").Select
    Dim LastLigneDepot As Variant
    LastLigneDepot = Range("A1").End(xlDown).Address
    LastLigneDepot = Range(LastLigneDepot).Row
 
 
'Mise à jour de la plage de donnée
    Sheets("TDDepot").PivotTables("TDdepot").ChangePivotCache ActiveWorkbook.PivotCaches. _
        Create(SourceType:=xlDatabase, SourceData:= _
        "Depot DATA!A1:I" & LastLigneDepot _
        , Version:=xlPivotTableVersion12)
'Mise à jour du tableau croisé dynamique de compilation
    Sheets("TDDepot").PivotTables("TDdepot").PivotCache.Refresh

Le problème est, que de temps en temps (suivant les données mis à jour) certaines étiquettes ne sont plus présentes dans "étiquette de ligne".
Elle sont toujours dans la plage et disponible dans le choix des champs à ajouter, mais mon TCD n'a plus la même forme, ce qui est embètant, car la macro effectue d'autres opération après qui necessite que la mise en forme reste la même.

Est ce que vous auriez une idée du pourquoi du comment?
Merci d'avance pour votre aide.
DaD

**Daniel.C** · 06/03/2012, 11h11

Bonjour,

Tu pourrais simplifier :

Code :

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

1
2
LastLigneDepot = Range("A1").End(xlDown).Address
    LastLigneDepot = Range(LastLigneDepot).Row

et mettre :

Code :

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

LastLigneDepot = Range("A1").End(xlDown).Row

mais le problème n'est pas là. A mon avis, il vient de ton classeur. Peux-tu le mettre en pièce jointe, en supprimant les données confidentielles ?

**DaD92** · 06/03/2012, 16h47

Merci Daniel pour ta réponse.

Je prends note pour la simplification. A mon avis, y'en a un paquet à faire dans mon code

Je ne peux malheureusement pas poster le fichier, y'a que des infos confidentielles dedans

Je peux poster du code sans soucis, y'a rien n'a cacher dedans, sauf mon ignorance en matière de developpement

Je te mets le code qu'il y a avant et après :

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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
 
'============================= -DEBUT- IMPORT DU FICHIER =======================================================
 
Dim classeurSource As Workbook, classeurDestination As Workbook
Dim CheminFichierDepot As Variant
 
' on récupère les variable du user form
CheminFichierDepot = UFFile.CheminFichierDepot.Value
 
 
Dim SourceFile As String
SourceFile = CheminFichierDepot
Dim s As Variant
 
 
'on teste si le fichier existe
s = SourceFile
Dim tatiak As Object
Dim ExisteFichier As Boolean
 
    Set tatiak = CreateObject("Scripting.FileSystemObject")
    ExisteFichier = tatiak.FileExists(s)
 
If ExisteFichier = False Then
    MsgBox "IMPORTANT : Le chemin du fichier des données de dépôt n'est pas valide. Merci de le changer et de relancer"
    Exit Sub
End If
 
 
 
'ouvrir le classeur source (en lecture seule)
Set classeurSource = Application.Workbooks.Open(SourceFile, , True)
 
'définir le classeur destination
Set classeurDestination = ThisWorkbook
 
'copier les données de la "Feuil1" du classeur source vers la "Feuil1" du classeur destination
classeurSource.Sheets("Feuil1").Cells.Copy classeurDestination.Sheets("Depot DATA").Range("A1")
 
'fermer le classeur source
classeurSource.Close False
 
 
 
 
'Calcul de la dernière ligne (onglet dépot)
    Sheets("Depot DATA").Select
    Dim LastLigneDepot As Variant
    LastLigneDepot = Range("A1").End(xlDown).Address
    LastLigneDepot = Range(LastLigneDepot).Row
 
'============================= -FIN- IMPORT DU FICHIER =======================================================
 
'Mise en forme
'on retire les couleur
'on converti la colonne article et client
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("A2").Select
 
 
 
'========= DEBUT Colonne donneur d'ordre ===========
    'insertion de la colonne donneur d'ordre
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "donneur d'ordre"
    Range("A2").Select
    Columns("A:A").EntireColumn.AutoFit
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[3],6)"
    Selection.AutoFill Destination:=Range("A2:A" & LastLigneDepot)
 
 
    'conversion de la colonne donneur d'ordre
    Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
 
 'nomage de la colonne qté
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Qté"
'========= FIN Colonne donneur d'ordre ===========
 
 
'============================= -DEBUT- COMPILATION Quantités =======================================================
 
 
'Mise à jour de la plage de donnée
    Sheets("TDDepot").PivotTables("TDdepot").ChangePivotCache ActiveWorkbook.PivotCaches. _
        Create(SourceType:=xlDatabase, SourceData:= _
        "Depot DATA!A1:I" & LastLigneDepot _
        , Version:=xlPivotTableVersion12)
'Mise à jour du tableau croisé dynamique de compilation
Sheets("TDDepot").PivotTables("TDdepot").PivotCache.Refresh
 
 
'on nétoie l'onglet depot compilé
    Sheets("Dépôt compilés").Select
    Cells.Select
    Selection.ClearContents
 
'on copie les données dans un nouvel onglet
    Sheets("TDDepot").Select
    Columns("A:F").Select
    Selection.Copy
    Sheets("Dépôt compilés").Select
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
 
 
 
 
'============================= -FIN- COMPILATION Quantités =======================================================
 
'============================= -DEBUT- Travail sur l'onglet des quantités compilés en dépôt ======================
 
Sheets("Dépôt compilés").Select
 
'on calcul sa dernière ligne
    Dim LastLigneDepotComiple As Variant
    LastLigneDepotComiple = Range("G1").End(xlDown).Address
    LastLigneDepotComiple = Range(LastLigneDepotComiple).Row
 
'On créer la colonne clef unique
    Range("A2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISBLANK(RC[1]),CONCATENATE(LEFT(R[-1]C,6),RC[2]),CONCATENATE(RC[1],RC[2]))"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Clef unique"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A" & LastLigneDepotComiple), Type:=xlFillDefault
 
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "donneur d'ordre"
 
'Mise en forme de la colonne hierarchie
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Hierarchie"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[1],6)"
    Selection.AutoFill Destination:=Range("F2:F" & LastLigneDepotComiple)
    Range("F2:F507").Select
    Columns("F:F").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("F1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("H2").Select
 
'rechercheV famille
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Famille"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],BDD!R2C1:R7C2,2,FALSE)"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H" & LastLigneDepotComiple)
    Columns("H:H").EntireColumn.AutoFit
 
'Insertion du nom client
    Columns("A:A").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Selection.ColumnWidth = 15.57
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],6)"
    Selection.AutoFill Destination:=Range("B2:B" & LastLigneDepotComiple)
 
'Copie spécial du donneur d'ordre
    Columns("B:B").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
 
'Création de la colonne nom
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Nom Client"
    Range("C2").Select
 
 
'RechercheV nom Client
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'Depot DATA'!R2C1:R" & LastLigneDepot & "C5,5,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C" & LastLigneDepotComiple)
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
 
 
'on calcul sa dernière des vendeur VI
    Sheets("BDD").Select
    Dim LastLigneVI As Variant
    LastLigneVI = Range("G2").End(xlDown).Address
    LastLigneVI = Range(LastLigneVI).Row
 
    Dim LastLigneCRM As Variant
    LastLigneCRM = Range("L2").End(xlDown).Address
    LastLigneCRM = Range(LastLigneCRM).Row
 
    Dim LastLigneNomVendeur As Variant
    LastLigneNomVendeur = Range("O2").End(xlDown).Address
    LastLigneNomVendeur = Range(LastLigneNomVendeur).Row
 
 
    Sheets("Dépôt compilés").Select
 
'récupération du nom du vendeur
    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEFT(RC[1],1)=""4"",VLOOKUP(CONCATENATE(RC[-4],RC[1]),BDD!R3C6:R" & LastLigneVI & "C7,2,FALSE),VLOOKUP(CONCATENATE(RC[-4],RC[1]),BDD!R3C11:R" & LastLigneCRM & "C12,2,FALSE))"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F" & LastLigneDepotComiple)
 
' création de la colonne nom vendeur
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Nom Vendeur"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-4],BDD!R3C14:R" & LastLigneNomVendeur & "C15,2,FALSE)"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J" & LastLigneDepotComiple)
    Columns("J:J").EntireColumn.AutoFit
 
'============================= -FIN- Travail sur l'onglet des quantités compilés en dépôt ======================
 
 
 
'Appel du traitement des ventes
Call Vente

Tu vois quelque chose qui cloche?

**Daniel.C** · 06/03/2012, 19h34

Je suis désolé, je n'ai pas le temps d'éplucher le code sans les données associées. Essaie la chose suivante. Copie les deux feuilles dans un classeur vierge et la partie du code concernant l'actualisation du TCD. Essaie de le faire fonctionner. Il est possible que le classeur actuel soit corrompu.

**DaD92** · 06/03/2012, 20h14

Je comprends.
Je vais essayer.
Merci

TCD et etiquette qui disparaisse lors d'un refresh

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager