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

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
 

Statistiques des forums

Discussions
311 730
Messages
2 081 991
Membres
101 856
dernier inscrit
Marina40