数据透视表标题显示多个选定项目

时间:2017-10-25 16:12:23

标签: excel-vba vba excel

我有一个数据透视图,当所选过滤器(工作中心)发生变化时,它会更新图表标题以显示该工作中心名称。但是,如果我选中该框以允许多个选择,则图表标题只显示“全部”而不是显示每个实际选定的项目。我还没有办法让它显示我正在寻找的东西。下面是我用来更新图表标题的代码以及触发它的过滤器更改事件的代码

Option Explicit

Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
    On Error Resume Next
    Application.Run "'Prod_Tools.xlam'!gPTWCChange", Target.PivotFields("WorkCenter").CurrentPage
    On Error GoTo 0
End Sub


Sub gPTWCChange(ByVal WC As String)
    Dim wb1 As Workbook
    Dim CPWB1 As Workbook
    For Each wb1 In Workbooks
        If InStr(1, wb1.Name, "Capacity Planning Rep", vbTextCompare) > 0 Then
            Set CPWB1 = Workbooks(wb1.Name)
            Exit For
        End If
    Next wb1
    On Error Resume Next
    CPWB1.Charts("Workcenter By Week").ChartTitle.Text = "Work Center: " & WC
    On Error GoTo 0
End Sub

我想要的是选择多个项目时,图表标题看起来像“Data for:Workcenter_A,Workcenter_B,Workcenter_F”

1 个答案:

答案 0 :(得分:1)

这是你的改编子。请注意,其参数已更改。

Public Sub gPTWCChange(ByVal pfWC As Excel.PivotField)
    Const sSEPARATOR As String = ", "

    Dim sChartTitle As String
    Dim oPivotItem As Excel.PivotItem
    Dim lVisibleCount As Long

    '... Your original code ...
    Dim wb1 As Workbook
    Dim CPWB1 As Workbook
    For Each wb1 In Workbooks
        If InStr(1, wb1.Name, "Capacity Planning Rep", vbTextCompare) > 0 Then
            Set CPWB1 = Workbooks(wb1.Name)
            Exit For
        End If
    Next wb1

    '... New code to compute the chart title ...        
    If pfWC.EnableMultiplePageItems Then
        'Build the chart title from the visible items in the PivotField.
        lVisibleCount = 0
        For Each oPivotItem In pfWC.PivotItems
            If oPivotItem.Visible Then
                lVisibleCount = lVisibleCount + 1
                sChartTitle = sChartTitle & sSEPARATOR & oPivotItem.Caption
            End If
        Next

        'Drop the leading separator.
        sChartTitle = Mid$(sChartTitle, Len(sSEPARATOR) + 1)

        'Manage plural.
        sChartTitle = "Work Center" & IIf(lVisibleCount > 1, "s", "") & ": " & sChartTitle
    Else
        sChartTitle = "Work Center: " & pfWC.CurrentPage
    End If

    '... Your original code ...
    On Error Resume Next        
    CPWB1.Charts("Workcenter By Week").ChartTitle.Text = sChartTitle
    On Error GoTo 0
End Sub

按以下方式拨打您的子电话:

Application.Run "'Prod_Tools.xlam'!gPTWCChange", Target.PivotFields("WorkCenter")

原则是向您的sub发送对PivotField对象的引用,并从那里检查其EnableMultiplePageItems属性。