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
|
Option Explicit
Sub CreationTcd(ByVal FeuilleSourceTcd As Worksheet, ByVal LigneTitreSource As Long, ByVal NomFeuilleTcd As String)
Dim AireTcd As Range
Dim DerniereLigne As Long
Dim DerniereColonne As Long
Dim ShTcd As Worksheet
Dim Pvt As PivotTable
With FeuilleSourceTcd
.Cells.EntireRow.Hidden = False
.Cells.EntireColumn.Hidden = False
DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row ' A adapter suivant la colonne de référence du tableau
DerniereColonne = .Cells(LigneTitreSource, .Columns.Count).End(xlToLeft).Column
Set AireTcd = .Range(.Cells(LigneTitreSource, 1), .Cells(DerniereLigne, DerniereColonne))
End With
' Suppression éventuelle feuille Tcd déjà existante
For Each ShTcd In Sheets
If ShTcd.Name = NomFeuilleTcd Then
Application.DisplayAlerts = False
ShTcd.Delete
Application.DisplayAlerts = True
Exit For
End If
Next ShTcd
' Création de l'onglet supportant le TCD
Set ShTcd = Worksheets.Add(after:=Sheets(Sheets.Count))
With ShTcd
.Name = NomFeuilleTcd
End With
' Création du Tcd
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=AireTcd, Version:=xlPivotTableVersion12). _
CreatePivotTable TableDestination:="'" & NomFeuilleTcd & "'!R3C1", TableName:="TCD1", DefaultVersion:=xlPivotTableVersion12
Set Pvt = ShTcd.PivotTables("TCD1")
With Pvt
With .PivotFields("Sexe")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Date")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField Pvt.PivotFields("Id"), "Nombre de Id", xlCount
' Groupement des années et des mois
.RowRange.Cells(3, 1).Group Start:=True, End:=True, Periods:=Array(False, False, False, False, True, False, True)
' Attribution d'un style
.TableStyle2 = "PivotStyleDark7"
' La zone ColumnRange est la zone au dessus des données
With .ColumnRange
.HorizontalAlignment = xlCenter
.ColumnWidth = 16
End With
' La zone DataBodyRange est la zone des données
With .DataBodyRange
.HorizontalAlignment = xlCenter
End With
End With
ActiveWindow.DisplayGridlines = False
Set AireTcd = Nothing
Set ShTcd = Nothing
End Sub |
Partager