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
| Sub ReorganiserLeTableau()
Dim ShTableau As Worksheet
Dim ShRecap As Worksheet
Dim LigneTitreRecap As Long
Dim DerniereColonneRecap As Long
Dim DerniereLigneRecap As Long
Dim J As Long
Dim OrdreTitre As Variant
Dim AireTitre As Range
Dim CelluleTitre As Range
Dim AireBordure As Range
Dim ColonneTrouvee As Boolean
Dim Continuer As Boolean
Dim Pvt As PivotTable
Set ShTableau = Sheets("tableau")
Set ShRecap = Sheets("Récap")
' Effacement de la feuille
ShRecap.Cells.Clear
LigneTitreRecap = 1
' Recherche du tableau dynamique dans la feuille tableau et copie dans la feuille Récap le cas échéant
Continuer = False
For Each Pvt In ShTableau.PivotTables
If Pvt.Name = "Tableau croisé dynamique1" Then
Continuer = True
Set Pvt = ShTableau.PivotTables("Tableau croisé dynamique1")
With ShTableau
.Range(.Cells(Pvt.RowRange.Row, Pvt.RowRange.Column), .Cells(Pvt.TableRange1.Row + Pvt.TableRange1.Rows.Count - 1, Pvt.TableRange1.Column + Pvt.TableRange1.Columns.Count - 1)).Copy
ShRecap.Activate
ShRecap.Paste Destination:=ShRecap.Range("A1")
End With
Set Pvt = Nothing
End If
Next Pvt
If Continuer = False Then Exit Sub
' On classe les valeurs cherchées dans l'ordre inverse final
OrdreTitre = Array("inconnu", 1, 0, "Total général")
With ShRecap
' Vérification de la présence des colonnes et création le cas échéant
For J = 1 To 4
DerniereColonneRecap = .Cells(LigneTitreRecap, .Columns.Count).End(xlToLeft).Column
Set AireTitre = .Range(.Cells(LigneTitreRecap, 2), .Cells(LigneTitreRecap, DerniereColonneRecap))
ColonneTrouvee = False
For Each CelluleTitre In AireTitre
If CelluleTitre = OrdreTitre(J - 1) Then ColonneTrouvee = True
Next CelluleTitre
' Si la colonne cherchée n'existe pas, on l'ajoute après la dernière colonne de la zone AireTitre
If ColonneTrouvee = False Then .Cells(LigneTitreRecap, DerniereColonneRecap + 1) = OrdreTitre(J - 1)
Set AireTitre = Nothing
Next J
' Déplacement des colonnes
For J = 1 To 4
DerniereColonneRecap = .Cells(LigneTitreRecap, .Columns.Count).End(xlToLeft).Column
Set AireTitre = .Range(.Cells(LigneTitreRecap, 2), .Cells(LigneTitreRecap, DerniereColonneRecap))
ColonneTrouvee = False
For Each CelluleTitre In AireTitre
If CelluleTitre = OrdreTitre(J - 1) Then
Columns(CelluleTitre.Column).Cut
If CelluleTitre.Column <> 2 Then
With Columns(2)
.Insert Shift:=xlToRight
.Cells.HorizontalAlignment = xlCenter
.ColumnWidth = 14
End With
End If
ColonneTrouvee = True
End If
Next CelluleTitre
Set AireTitre = Nothing
Next J
' Mise en forme de la ligne de titre
Set AireTitre = .Range(.Cells(LigneTitreRecap, 1), .Cells(LigneTitreRecap, DerniereColonneRecap))
With AireTitre
.Interior.Color = RGB(220, 230, 241)
.Font.Bold = True
.WrapText = True
.EntireColumn.VerticalAlignment = xlCenter
.Cells(1) = "Individu"
End With
Set AireTitre = Nothing
' Mise en forme de la dernière ligne "Total général"
DerniereLigneRecap = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(DerniereLigneRecap, 1) = "Total général" Then
Set AireTitre = .Range(.Cells(DerniereLigneRecap, 1), .Cells(DerniereLigneRecap, DerniereColonneRecap))
With AireTitre
.Interior.Color = RGB(220, 230, 241)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
Set AireTitre = Nothing
End If
' Mise en place des bordures du tableau
DerniereLigneRecap = .Cells(.Rows.Count, 1).End(xlUp).Row
Set AireBordure = .Range(.Cells(LigneTitreRecap, 1), .Cells(DerniereLigneRecap, DerniereColonneRecap))
With AireBordure
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).Weight = xlThin
If AireBordure.Rows.Count > 1 Then .Borders(xlInsideHorizontal).Weight = xlThin
End With
Set AireBordure = Nothing
End With
Set ShRecap = Nothing
Set ShTableau = Nothing
End Sub |
