Microsoft 365 VBA - TCD - Liste des champs et filtres verrouillés

T

Tinytoons

XLDnaute Nouveau
Bonjour,

Je cherchais un code vba qui me permet de créer des TCD tout en ayant la possibilité d'utliliser la fonction "Total distinct". J'en ai trouvé un que j'ai ajusté selon mes besoins pour créer trois TCD (qui ont chacun leur source de data) sur une même macro. Les trois TCD sont quasi-identiques avec 5 filtres (le 1er TCD a un filtre de plus) et trois valeurs. Le code fonctionne parfaitement mais je fais face à un problème que je n'arrive pas à résoudre malgré mes nombreuses rehcerches sur Internet. En effet, mes trois TCD sont bien créés mais les deux premiers TCD ont leurs listes de champs et leurs filtres verrouillés contrairement à celui qui est positionné dans la macro comme le troisième TCD pour lequel il n'y a pas de problème. J'ai fait un test en supprimant les deux derniers TCD de la macro et en gardant seulement le 1er et là j'ai bien accès à la liste de champs et au filtre. J'ai fait un test avec le deuxième TCD en supprimant de la macro le 1er et le 3ème TCD et là aussi j'ai bien accès à la liste de champs et au filtre. Au final il semble que j'ai accès à la liste des champs et au filtre d'un TCD uniquement si il n'est pas suivi d'un autre TCD.

Ci-dessous le code en question:

VB: 
Sub KPI()
Application.ScreenUpdating = False
' First Pivot Table
Dim objSheetWithData As Worksheet
Dim objSheetWithPivot As Worksheet
Dim objListObjectWithData As ListObject
Dim objConnection As WorkbookConnection
Dim objPivotCache As PivotCache
Dim objPivotTable As PivotTable
Dim objCubeField As CubeField
Dim objPivotField As PivotField
Set objSheetWithData = ActiveWorkbook.Sheets("LIVRAISON")
Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD SERVICE LEVEL")
If objSheetWithData.ListObjects.Count > 0 Then
    Set objListObjectWithData = objSheetWithData.ListObjects(1)
Else
    Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                SourceType:=xlSrcRange, _
                                Source:=objSheetWithData.Range("LIVRAISON"), _
                                XlListObjectHasHeaders:=xlYes)
End If
For Each objConnection In ActiveWorkbook.Connections
    If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
Next objConnection
Set objConnection = ActiveWorkbook.Connections.Add2( _
                    Name:="My Connection", _
                    Description:="My Connection Description", _
                    ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                    CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                    lCmdtype:=XlCmdType.xlCmdExcel, _
                    CreateModelConnection:=True, _
                    ImportRelationships:=False)
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                    SourceType:=xlExternal, _
                    SourceData:=objConnection)
With objPivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsNone
End With
For Each objPivotTable In objSheetWithPivot.PivotTables
    objPivotTable.TableRange2.Clear
Next objPivotTable
Set objPivotTable = objPivotCache.CreatePivotTable( _
                    TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD LIVRAISON")
With objPivotTable.CubeFields(7)
    .Orientation = xlPageField
    .Caption = "IDH + Designation"
End With
objPivotTable.PageFields(1).Caption = "IDH + Designation"
With objPivotTable.CubeFields(9)
    .Orientation = xlPageField
    .Caption = "Brand"
End With
objPivotTable.PageFields(2).Caption = "Brand"
With objPivotTable.CubeFields(11)
    .Orientation = xlPageField
    .Caption = "Market"
End With
objPivotTable.PageFields(3).Caption = "Market"
With objPivotTable.CubeFields(8)
    .Orientation = xlPageField
    .Caption = "Type of Product"
End With
objPivotTable.PageFields(4).Caption = "Type of Product"
With objPivotTable.CubeFields(10)
    .Orientation = xlPageField
    .Caption = "Business Unit"
End With
objPivotTable.PageFields(5).Caption = "Business Unit"
With objPivotTable.CubeFields(15)
    .Orientation = xlPageField
    .Caption = "100% ?"
End With
objPivotTable.PageFields(6).Caption = "100% ?"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(14), _
                   Function:=xlAverage, _
                   Caption:="Service Rate")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(1).Caption = "Service Level (%)"
objPivotTable.DataFields(1).NumberFormat = "0.00%"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(13), _
                   Function:=xlSum, _
                   Caption:="Quantity delivered")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(2).Caption = "Quantity Delivered (PAL)"
objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(7), _
                   Function:=xlDistinctCount, _
                   Caption:="IDH + Designation")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(3).Caption = "Number of SKUs"
objPivotTable.DataFields(3).NumberFormat = "#,##0"

' Second Pivot Table
Set objSheetWithData = ActiveWorkbook.Sheets("NDR")
Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD RUPTURE RATE")
If objSheetWithData.ListObjects.Count > 0 Then
    Set objListObjectWithData = objSheetWithData.ListObjects(1)
Else
    Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                SourceType:=xlSrcRange, _
                                Source:=objSheetWithData.Range("NDR"), _
                                XlListObjectHasHeaders:=xlYes)
End If
For Each objConnection In ActiveWorkbook.Connections
    If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
Next objConnection
Set objConnection = ActiveWorkbook.Connections.Add2( _
                    Name:="My Connection", _
                    Description:="My Connection Description", _
                    ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                    CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                    lCmdtype:=XlCmdType.xlCmdExcel, _
                    CreateModelConnection:=True, _
                    ImportRelationships:=False)
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                    SourceType:=xlExternal, _
                    SourceData:=objConnection)
With objPivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsNone
End With
For Each objPivotTable In objSheetWithPivot.PivotTables
    objPivotTable.TableRange2.Clear
Next objPivotTable
Set objPivotTable = objPivotCache.CreatePivotTable( _
                    TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD NDR")
With objPivotTable.CubeFields(6)
    .Orientation = xlPageField
    .Caption = "IDH + Designation"
End With
objPivotTable.PageFields(1).Caption = "IDH + Designation"
With objPivotTable.CubeFields(8)
    .Orientation = xlPageField
    .Caption = "Brand"
End With
objPivotTable.PageFields(2).Caption = "Brand"
With objPivotTable.CubeFields(10)
    .Orientation = xlPageField
    .Caption = "Market"
End With
objPivotTable.PageFields(3).Caption = "Market"
With objPivotTable.CubeFields(7)
    .Orientation = xlPageField
    .Caption = "Type of Product"
End With
objPivotTable.PageFields(4).Caption = "Type of Product"
With objPivotTable.CubeFields(9)
    .Orientation = xlPageField
    .Caption = "Business Unit"
End With
objPivotTable.PageFields(5).Caption = "Business Unit"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(5), _
                   Function:=xlSum, _
                   Caption:="CPV (OOS) [EUR]")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(1).Caption = "OOS (EUR)"
objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(4), _
                   Function:=xlSum, _
                   Caption:="(OOS) [CON]")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(2).Caption = "OOS (CON)"
objPivotTable.DataFields(2).NumberFormat = "#,##0"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(6), _
                   Function:=xlDistinctCount, _
                   Caption:="IDH + Designation")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(3).Caption = "Number of SKUs"
objPivotTable.DataFields(3).NumberFormat = "#,##0"

' Third Pivot Table
Set objSheetWithData = ActiveWorkbook.Sheets("PRODUCTION")
Set objSheetWithPivot = ActiveWorkbook.Sheets("TCD VALUE AND VOLUME")
If objSheetWithData.ListObjects.Count > 0 Then
    Set objListObjectWithData = objSheetWithData.ListObjects(1)
Else
    Set objListObjectWithData = objSheetWithData.ListObjects.Add( _
                                SourceType:=xlSrcRange, _
                                Source:=objSheetWithData.Range("PRODUCTION"), _
                                XlListObjectHasHeaders:=xlYes)
End If
For Each objConnection In ActiveWorkbook.Connections
    If objConnection.Type = xlConnectionTypeWORKSHEET Then objConnection.Delete
Next objConnection
Set objConnection = ActiveWorkbook.Connections.Add2( _
                    Name:="My Connection", _
                    Description:="My Connection Description", _
                    ConnectionString:="WORKSHEET;" & ActiveWorkbook.Name, _
                    CommandText:=objListObjectWithData.Parent.Name & "!" & objListObjectWithData.Name, _
                    lCmdtype:=XlCmdType.xlCmdExcel, _
                    CreateModelConnection:=True, _
                    ImportRelationships:=False)
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
                    SourceType:=xlExternal, _
                    SourceData:=objConnection)
With objPivotCache
    .RefreshOnFileOpen = False
    .MissingItemsLimit = xlMissingItemsNone
End With
For Each objPivotTable In objSheetWithPivot.PivotTables
    objPivotTable.TableRange2.Clear
Next objPivotTable
Set objPivotTable = objPivotCache.CreatePivotTable( _
                    TableDestination:=objSheetWithPivot.Range("A1"), TableName:="TCD PRODUCTION")
With objPivotTable.CubeFields(9)
    .Orientation = xlPageField
    .Caption = "IDH + Designation"
End With
objPivotTable.PageFields(1).Caption = "IDH + Designation"
With objPivotTable.CubeFields(11)
    .Orientation = xlPageField
    .Caption = "Brand"
End With
objPivotTable.PageFields(2).Caption = "Brand"
With objPivotTable.CubeFields(13)
    .Orientation = xlPageField
    .Caption = "Market"
End With
objPivotTable.PageFields(3).Caption = "Market"
With objPivotTable.CubeFields(10)
    .Orientation = xlPageField
    .Caption = "Type of Product"
End With
objPivotTable.PageFields(4).Caption = "Type of Product"
With objPivotTable.CubeFields(12)
    .Orientation = xlPageField
    .Caption = "Business Unit"
End With
objPivotTable.PageFields(5).Caption = "Business Unit"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(5), _
                   Function:=xlSum, _
                   Caption:="Stock Value")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(1).Caption = "Stock Value (EUR)"
objPivotTable.DataFields(1).NumberFormat = "#,##0.00 €"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(15), _
                   Function:=xlSum, _
                   Caption:="Amount of PAL")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(2).Caption = "Quantity Produced (PAL)"
objPivotTable.DataFields(2).NumberFormat = "#,##0.00"
Set objCubeField = objPivotTable.CubeFields.GetMeasure( _
                   AttributeHierarchy:=objPivotTable.CubeFields(9), _
                   Function:=xlDistinctCount, _
                   Caption:="IDH + Designation")
objPivotTable.AddDataField objCubeField
objPivotTable.DataFields(3).Caption = "Number of SKUs"
objPivotTable.DataFields(3).NumberFormat = "#,##0"
Application.ScreenUpdating = True
End Sub
 
Trier par date Trier par votes

Discussions similaires

C
  • Question
CREATION DE PLUSIEURS TCD VBA
2
Réponses
23
Affichages
4 K
Charles78
C
C
  • Question
Microsoft 365 GRAPHIQUE VBA - COMMENT INDIQUER UNE VALEUR A ZERO SUR LE GRAPHIQUE
Réponses
5
Affichages
1 K
Charles78
C
D
  • Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
2 K
chris
chris
O
  • Question
Macro Création TCD
Réponses
2
Affichages
2 K
Olim
O
miguelangelo
  • Question
vba : creation tcd et forcer le nom des champs
Réponses
2
Affichages
3 K
miguelangelo
miguelangelo

Membres actuellement en ligne

18 membres et 324 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh