VBAでピボットテーブル フィールドの選択（抽出）⇒印刷を自動化したい

Question

客先ごとに【ピボットテーブルのフィールドを選択（抽出）⇒印刷】の作業をExcel VBAで自動化したい

社内でピボットテーブルで展開されるデータがあり、自分が担当する客先をフィルター検索して抽出し、表示された範囲を印刷するという作業を、客先1件ずつ行っています。
この作業（抽出～印刷×客先分）を自動化したく考えているのですが、下記のコードだと上手くいかず悩んでいます。
拙い説明で恐縮ですが、何か良い解決方法があればご教示いただければ幸いです。
よろしくお願いいたします。

≪ピボットテーブル概要≫
A列：社内チーム名
B列：客先（※この項目をフィルターで抽出しています）
C列：商品
D列～：商品の売り上げ個数、単価、総額等

発生している問題・エラーメッセージ

①抽出に時間がかかる（1分以上）
②1回分の抽出しかできない

該当のソースコード

Sub フィルターを設定する()
　Dim pvItm As PivotItem
　For Each pvItm In ActiveSheet.PivotTables(1).PivotFields("客先").PivotItems
　　Select Case pvItm.Value
　　　Case "顧客A"
　　　　pvItm.Visible = True
　　　Case Else
　　　　pvItm.Visible = False
　　End Select
　Next pvItm
End Sub

Answer 1

こんなのでどうでしょう。

Sub フィルターを設定する(pvField As PivotField, itemName As String)
    Dim pvItm As PivotItem
    pvField.PivotItems(itemName).Visible = True
    For Each pvItm In pvField.PivotItems
        If pvItm.Value <> itemName Then
            pvItm.Visible = False
        End If
    Next pvItm
End Sub

Public Sub 印刷()
    Dim pvTable As PivotTable
    Dim pvField As PivotField
    Dim pvItm As PivotItem
    Set pvTable = ActiveSheet.PivotTables(1)
    Set pvField = pvTable.PivotFields("客先")
    pvTable.ManualUpdate = True
    For Each pvItm In pvField.PivotItems
        フィルターを設定する pvField, pvItm.Value
        pvTable.Update
        ' ここで印刷処理
        'ActiveSheet.ExportAsFixedFormat xlTypePDF, pvItm.Value & ".pdf"
    Next pvItm
    pvTable.ManualUpdate = False
End Sub

・全ての顧客で、それぞれ絞れるように関数化しています。
・速度対策でpvTable.ManualUpdateにより自動更新を停止してから、pvTable.Updateにより反映しています。

という感じです。
印刷は時間がかかるかと思いますが、それは仕方ないとして
それなりにいけるんじゃないかと思います。

見逃してましたが「自分が担当する客先」分のみ印刷ということであれば
シートで管理してもいいですが、とりあえず簡単にコード埋め込みで

Public Sub 印刷2()
    Dim pvTable As PivotTable
    Dim pvField As PivotField
    Dim col顧客 As New Collection
    Dim 顧客 As Variant
    Dim msg As String
    col顧客.Add "顧客A"
    col顧客.Add "顧客B"
    col顧客.Add "顧客C"
    Set pvTable = ActiveSheet.PivotTables(1)
    Set pvField = pvTable.PivotFields("客先")
    pvTable.ManualUpdate = True

    For Each 顧客 In col顧客
        On Error Resume Next
        pvField.PivotItems 顧客
        If Err.Number = 1004 Then
            msg = msg & vbCrLf & 顧客
            On Error GoTo 0
        Else
            On Error GoTo 0
            フィルターを設定する pvField, CStr(顧客)
            pvTable.Update
            ' ここで印刷処理
            'ActiveSheet.ExportAsFixedFormat xlTypePDF, 顧客 & ".pdf"
        End If
    Next 顧客
    pvTable.ManualUpdate = False
    If msg = "" Then
        MsgBox "印刷完了"
    Else
        MsgBox "印刷完了。以下の顧客データが存在しませんでした" & msg, vbExclamation
    End If
End Sub

Comments

[sall]

早速のご回答ありがとうございます！
希望通りの動作で、感動いたしました！！
大変助かりましたし、本当に勉強になります。
このようなご丁寧な回答をいただけたことも嬉しく、心から感謝申し上げます。
今後ともよろしくお願いいたします。