[已解决]分别选择数据透视表姓名字段所有姓名并执行“打印”宏

LangQueS

求宏代码：分别选择数据透视表姓名字段所有姓名并执行“打印”宏（即打印分别每个人的报表）。谢谢！

备注：姓名数量不确定；“空白”不选择

Rzz4eKcm.rar (9.45 KB, 下载次数: 74)

2007-9-19 08:55 上传

点击文件名下载附件
[求助]分别选择数据透视表姓名字段所有姓名并执行“打印”宏

[此贴子已经被作者于2007-9-21 18:14:03编辑过]

wanderchen

看看这样能满足要求不
Sub Macro2()
Dim pntAddress As Range
Application.ScreenUpdating = False
 PIcnt = ActiveSheet.PivotTables("数据透视表2").PivotFields("姓名").PivotItems.Count
 With ActiveSheet.PivotTables("数据透视表2").PivotFields("姓名")
     For i = 2 To PIcnt
        .PivotItems(1).Visible = True
        .PivotItems(i).Visible = False
     Next i
     Set pntAddress = Range("F1", "H" & getlastusedrow(Range("F1")))
     ActiveSheet.PageSetup.PrintArea = pntAddress.Address
     ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    
     For j = 2 To PIcnt - 1
        .PivotItems(j).Visible = True
        .PivotItems(j - 1).Visible = False
        Set pntAddress = Range("F1", "H" & getlastusedrow(Range("F1")))
        ActiveSheet.PageSetup.PrintArea = pntAddress.Address
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Next j
End With
Application.ScreenUpdating = True
End Sub

Function getlastusedrow(rg As Range) As Long
Dim lmaxrows As Long
lmaxrows = ThisWorkbook.Worksheets(1).Rows.Count
If IsEmpty(rg.Parent.Cells(lmaxrows, rg.Column)) Then
    getlastusedrow = rg.Parent.Cells(lmaxrows, rg.Column).End(xlUp).Row
Else
    getlastusedrow = rg.Parent.Cells(lmaxrows, rg.Column).Row
End If
End Function

[此贴子已经被作者于2007-9-19 10:18:30编辑过]

LangQueS

谢谢wanderchen兄的代码，经过验证结果正确。

可否将代码简化一下：将数据透视表中的姓名全选后再取消全选，可一次取消全部姓名的选择，不必一个一个取消。不知道我是否说清楚了。

wanderchen

在打印之前，先人工选择第一项是选择，其他不选择，这样速度快点
Sub Macro2()
Dim pntAddress As Range
Application.ScreenUpdating = False
 With ActiveSheet.PivotTables("数据透视表2").PivotFields("姓名")
 PIcnt = .PivotItems.Count
     Set pntAddress = Range("F1", "H" & getlastusedrow(Range("F1")))
     ActiveSheet.PageSetup.PrintArea = pntAddress.Address
     ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    
     For j = 2 To PIcnt - 1
        .PivotItems(j).Visible = True
        .PivotItems(j - 1).Visible = False
        Set pntAddress = Range("F1", "H" & getlastusedrow(Range("F1")))
        ActiveSheet.PageSetup.PrintArea = pntAddress.Address
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Application.StatusBar = J & " / " & PIcnt - 1
    Next j
End With
Application.ScreenUpdating = True
End Sub

Function getlastusedrow(rg As Range) As Long
Dim lmaxrows As Long
lmaxrows = ThisWorkbook.Worksheets(1).Rows.Count
If IsEmpty(rg.Parent.Cells(lmaxrows, rg.Column)) Then
    getlastusedrow = rg.Parent.Cells(lmaxrows, rg.Column).End(xlUp).Row
Else
    getlastusedrow = rg.Parent.Cells(lmaxrows, rg.Column).Row
End If
End Function

[此贴子已经被作者于2007-9-19 11:21:57编辑过]

LangQueS

wanderchen兄在4楼的代码大概遗漏了循环打印。

wanderchen

是我漏删了ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True前的“'”号

因为测试的时候不需要执行这代码，所有我屏蔽了

现在已经改正

LangQueS

代码正确，非常感谢wanderchen兄！

再请教一点，当数据透视表没有“空白”选项，或“空白”选项不在选项列表的最后，上边的代码也正确吧？

[此贴子已经被作者于2007-9-19 11:54:36编辑过]

wanderchen

对着透视表按右键，字段设置\高级下，选择 升序

这样就该解决问题了

[此贴子已经被作者于2007-9-19 12:23:25编辑过]

LangQueS

再次谢谢wanderchen兄！

这段代码以后会经常用到，如果还能有更通用、更完美的代码，因此也请你或其他朋友继续研究修改。

可以改进的地方：

1、执行代码前要手工取消透视表的全部选项并选择好第一个选项；

2、代码中限制了透视表的列区间（可否只需指定透视表的选项单元，这样可适应不同列数量的情况）；

3、透视表要事先定义排序，将“空白”选项排到最后，不能自动识别“空白”。

[此贴子已经被作者于2007-9-19 14:32:59编辑过]

山菊花

函数版，试试：

GNz3BxGi.zip (13.51 KB, 下载次数: 65)

2007-9-20 09:06 上传

点击文件名下载附件
[求助]分别选择数据透视表姓名字段所有姓名并执行“打印”宏