Excel Office 365 VBA - сводная таблица - список полей и фильтров заблокирован - PullRequest
Новая
       22

Excel Office 365 VBA - сводная таблица - список полей и фильтров заблокирован

0 голосов
/ 25 октября 2019

Я нашел на веб-сайте ответ на мой вопрос о том, как создать сводную таблицу с помощью VBA и иметь возможность выбрать функцию "xlDistinctCount" Создание сводной таблицы с помощью счетчика с использованием VBA путем настройкикод, который мне нужен. На самом деле, я использовал код Асгера для создания трех сводных таблиц (с тремя различными источниками данных) в одном макросе, и он работает очень хорошо, особенно в отношении функции "xlDistinctCount, но я столкнулся с одной проблемой:

Что касается трех сводных таблиц, две первые из них имеют свой список полей и фильтры, которые заблокированы, в то время как для того, который был создан последним, у меня есть доступ к ним. Я сделал тест, удалив две последние сводные таблицы, и яосталось только первое, и в результате у меня есть доступ к списку полей и фильтров. Почему у меня есть доступ к списку полей и фильтрам сводной таблицы, только когда нет другой сводной таблицы, которая следует?

Ниже моего кода: 

    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
...