Need macro that selects an item off pivot page filter, prints, se.

H

hoppermr2004

Simple excel macro question;

I need the VBA syntax that selects an item off a pivot table page filter,
prints the page, selects next item off the page filter, prints etc until I
get to the end of the filter list.

ta
 
T

Tom Ogilvy

Set up to work on a pivot table on Sheet4. If PrintFlag is not set to true,
it writes descriptive information on Sheet3 (to test it). It will work with
multiple pagefields.

Option Compare Text
Public mrow As Integer
Public PrintFlag As Boolean

Sub PrintAllPages()
Dim holdSettings
mrow = 0
PrintFlag = True
If Not PrintFlag Then
Worksheets("Sheet3").Cells(1, 1).CurrentRegion.Clear
End If
Set PvtTbl = Worksheets("Sheet4").PivotTables(1)
Worksheets("Sheet4").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
I = 1
For Each PgeField In PvtTbl.PageFields
PgeField.CurrentPage = holdSettings(I)
I = I + 1
Next PgeField

End Sub
Sub DrillPvt(oTable, Ipage)
'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
Else
For j = 1 To .PageFields.Count
Worksheets("Sheet3").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
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
End If
End Sub
 
Top