数据透视表系列讲座9/15---打印

打印 数据透视表页字段中的每个数据项
下面的代码将能够实现打印页字段中的每个数据项的功能(假定为一个页字段).请使用打印预览测试. 准备打印时, 请去掉 ActiveSheet.PrintOut代码前的单引号, 并在代码ActiveSheet.PrintPreview前添加一个单引号.

Sub PrintPivotPages()

 '打印数据透视表一个页字段下的每个数据项

 '假设只有一个页字段存在

On Error Resume Next

Dim pt As PivotTable

Dim pf As PivotField

Dim pi As PivotItem

Set pt = ActiveSheet.PivotTables.Item(1)

  For Each pf In pt.PageFields

         For Each pi In pf.PivotItems

           pt.PivotFields(pf.Name).CurrentPage = pi.Name

'           ActiveSheet.PrintOut  '使用这个代码打印

           ActiveSheet.PrintPreview  '使用这个代码预览

         Next

  Next pf

End Sub          

            
打印数据透视表页字段下每个数据项的透视图
下面的代码将能够实现打印页字段中的每个数据项的透视图功能(假定为一个页字段).请使用打印预览测试. 准备打印时, 请去掉 ActiveSheet.PrintOut代码前的单引号, 并在代码ActiveSheet.PrintPreview前添加一个单引号.  
            
Sub PrintPivotCharts()
            
 'prints a chart for each item in the page field
            
Dim pt As PivotTable
            
Dim pf As PivotField
            
Dim pi As PivotItem
            
Set pt = ActiveChart.PivotLayout.PivotTable
            
  For Each pf In pt.PageFields
            
         For Each pi In pf.PivotItems
            
           pt.PivotFields(pf.Name).CurrentPage = pi.Name
            
'           ActiveSheet.PrintOut
            
           ActiveSheet.PrintPreview  '打印预览测试
            
         Next
            
  Next pf
            
End Sub   
            
            
打印数据透视表的每个页数据项 – 多个页字段
下面代码将完成打印数据透视表页数据项的每个组合. 如果 PrintFlag 不设置为 true, 描述信息将被写入PageItemList工作表.
            
Option Compare Text
            
Public mrow As Integer
            
Public PrintFlag As Boolean
            
'====================================================================
            
Sub PrintAllPages()
            
'from code posted by Tom Ogilvy
            
'September 5 2004
            
Dim holdSettings
            
Dim ws As Worksheet
            
Dim wsPT As Worksheet
            
Set ws = Worksheets("PageItemList") 'sheet for page items
            
Set wsPT = Worksheets("Pivot") 'sheet with PivotTable
            
mrow = 0
            
If MsgBox("Print?", vbYesNo, "Print?") = vbYes Then
            
  PrintFlag = True
            
Else
            
  PrintFlag = False
            
  MsgBox "Page field items will be listed on sheet " & ws.Name
            
End If
            
If Not PrintFlag Then
            
  ws.Cells(1, 1).CurrentRegion.Clear
            
End If
            
Set PvtTbl = wsPT.PivotTables(1)
            
wsPT.Activate
            
If PvtTbl.PageFields.Count = 0 Then
            
  MsgBox "The PivotTable has no Pages"
            
  Exit Sub
            
End If
            
With PvtTbl
            
ReDim holdSettings(1 To .PageFields.Count)
            
I = 1
            
For Each PgeField In .PageFields
            
  holdSettings(I) = PgeField.CurrentPage.Name
            
  I = I + 1
            
  PgeField.CurrentPage = PgeField.PivotItems(1).Name
            
Next PgeField
            
End With
            
 
            
PvtPage = 1
            
PvtItem = 1
            
DrillPvt oTable:=PvtTbl, Ipage:=PvtPage, wksht:=ws
            
I = 1
            
For Each PgeField In PvtTbl.PageFields
            
 PgeField.CurrentPage = holdSettings(I)
            
  I = I + 1
            
Next PgeField
            
 
            
End Sub
            
'====================================================================
            
Sub DrillPvt(oTable, Ipage, wksht)
            
'Debug.Print "in DrillPvt, page:=" & Ipage & " Page Item: " & _
            
'  oTable.PageFields(Ipage).CurrentPage & " " & mrow
            
If Ipage = oTable.PageFields.Count Then
            
 With oTable
            
  For I = 1 To .PageFields(Ipage).PivotItems.Count
            
        .PageFields(Ipage).CurrentPage = _
            
        .PageFields(Ipage).PivotItems(I).Name
            
        mrow = mrow + 1
            
        slist = ""
            
        For j = 1 To .PageFields.Count
            
          slist = slist & .PageFields(j).CurrentPage & " "
            
        Next j
            
 '  Debug.Print slist
            
        If PrintFlag Then
            
''         ActiveSheet.PrintOut  'print the sheet
            
         ActiveSheet.PrintPreview  'preview -- for testing
            
        Else
            
         For j = 1 To .PageFields.Count
            
          wksht.Cells(mrow, j).Value = _
            
           .PageFields(j).CurrentPage.Name
            
         Next j
            
        End If
            
  Next I
            
 End With
            
 For I = oTable.PageFields.Count - 1 To 1 Step -1
            
        For j = 1 To oTable.PageFields(I).PivotItems.Count
            
          If oTable.PageFields(I).CurrentPage = _
            
           oTable.PageFields(I).PivotItems(j).Name Then
            
             CurrItem = j
            
             Exit For
            
          End If
            
        Next j
            
        If CurrItem <> oTable.PageFields(I).PivotItems.Count Then
            
           oTable.PageFields(I).CurrentPage = _
            
             oTable.PageFields(I).PivotItems(CurrItem + 1).Name
            
           Ipage = I + 1
            
           DrillPvt oTable, Ipage, wksht
            
        Else
            
          If I <> 1 Then
            
            oTable.PageFields(I).CurrentPage = _
            
             oTable.PageFields(I).PivotItems(1).Name
            
          Else
            
            Exit Sub
            
          End If
            
        End If
            
 Next I
            
Else
            
 DrillPvt oTable, Ipage + 1, wksht
            
End If
            
End Sub