Fusion des cellules identiques d'une partie d'un TCD - macro VBA

Version imprimable

Bonjour,

J'ai créé une macro permettant de générer un TCD à partir de données.
Je voudrais que seulement la colonne B de mon TCD ait les cellules identiques qui se fusionnent. Je veux donc appliquer la fonction "fusionner et centrer les étiquettes" uniquement sur cette colonne et non pas sur le tableau croisé dynamique entier.

Comment faire ?

Voici un exemple de mon code :

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
 
Sub test()
 
'Creation TCD
Range("A1").CurrentRegion.Select
ActiveWorkbook.Names.Add Name:="BD", RefersToR1C1:=Selection
 
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDa tabase, SourceData:= _
"BD", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:="", TableName:="Pivot_Table_2", _
DefaultVersion:=xlPivotTableVersion14
 
 
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("Pivot_Table_2").PivotFiel ds( _
"A")
.Orientation = xlRowField
.Position = 1
End With
 
With ActiveSheet.PivotTables("Pivot_Table_2").PivotFiel ds( _
"B")
.Orientation = xlRowField
.Position = 2
End With
 
With ActiveSheet.PivotTables("Pivot_Table_2").PivotFiel ds( _
"C")
.Orientation = xlRowField
.Position = 3
End With
 
'Enelever totaux, sous totaux etc
Dim p As PivotField
For Each p In ActiveSheet.PivotTables(1).PivotFields
If p.Orientation = 1 Then p.Subtotals = Array(False, False, False, False, _
False, False, False, False, False, False, False, False)
Next p
 
With ActiveSheet.PivotTables("Pivot_Table_2")
.ColumnGrand = False
.RowGrand = False
End With
ActiveSheet.PivotTables("Pivot_Table_2").RowAxisLa yout xlTabularRow
 
'Activer fusion des cellules identiques
ActiveSheet.PivotTables("Pivot_Table_2").MergeLabels = True
 
'Conserver format des cellules et ajustement auto
With ActiveSheet.PivotTables("Pivot_Table_2")
.HasAutoFormat = False
.PreserveFormatting = True
End With
 
End Sub

Je souhaiterais finalement appliquer la fonction .MergeLabels = True uniquement à ma colonne B de mon TCD.

En vous remerciant par avance,

Cordialement.

09/06/2016, 11h40
78chris

Bonjour

J'ai vu ta question sur un autre forum. Je n'ai pas répondu car je ne vois pas l'intérêt des fusions et dans les TCD je trouve cela particulièrement laid... (mais les goûts et les couleurs...)
Cela implique aussi d'utiliser la disposition tabulaire héritée des anciennes versions mais pas vraiment optimisée pour les version 2007 et suivantes (notamment pas compatibles avec les styles de TCD qui bien utilisés permettent une présentation facilitant l'analyse).

Pour répondre à ta question ce n'est pas prévu dans les TCD : c'est une option globale comme tu l'as constaté et pour ma part je n'y arrive pas manuellement non plus... et ce qui n'est pas faisable manuellement ne l'est généralement pas par VBA
09/06/2016, 14h19
boostiik

Merci pour votre réponse.

Le problème c'est que dans ma colonne B, il y a de nombreuses fois la même valeur. C'est pour cette raison qu'esthétiquement, je souhaitais effectuer cette fusion.

Sinon, j'ai appliqué la fusion des cellules au TCD entier et j'ai annulé la fusion sur toutes colonnes sauf la B. Cette solution fonctionne mais lorsque j'actualise le TCD en effectuant un tri au niveau des étiquettes notamment, la fusion s'applique à nouveau sur tout le tableau.
Auriez-vous une idée d'astuce pour palier à ce problème ?

Merci,

Cordialement.
09/06/2016, 21h46
78chris

Re

Si la valeur se répète c'est sans doute que l'option "Répéter les étiquettes d'éléments" est cochée car la fusion ne peut se faire que sur un sous-ensemble.

Décoche l'option et tu n'auras pas de répétition pour un même niveau dans la colonne A...

Sinon sur mes TCD je ne peux pas plus défusionner une colonne manuellement que fusionner : il est curieux que tu y parviennes...