ここでは 複数ブックにまたがって条件付きでピボットテーブルを複数種類同時にグラフ化してエクスポートする VBAの例を紹介します。ポイントは「複数ブックをループして条件に合致するピボットテーブルを探し、その結果をグラフ化して別ブックにまとめる」ことです。
基本例：数量・売上ピボットをグラフ化して統合ブックにエクスポート
Sub 複数ブックでピボットグラフエクスポート()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim destWb As Workbook
Dim destWs As Worksheet
Dim chartObj As ChartObject
Dim pasteTop As Long
' 統合先ブックを指定（事前に開いておく）
Set destWb = Workbooks("PivotMaster.xlsx")
Set destWs = destWb.Sheets("Export")
destWs.Cells.Clear
pasteTop = 20
For Each wb In Application.Workbooks
If wb.Name <> ThisWorkbook.Name And wb.Name <> destWb.Name Then
For Each ws In wb.Worksheets
' 条件：シート名が「Data」
If ws.Name = "Data" Then
For Each pt In ws.PivotTables
' ピボット名に「数量」または「売上」が含まれる場合のみ対象
If InStr(pt.Name, "数量") > 0 Or InStr(pt.Name, "売上") > 0 Then
' グラフを作成
Set chartObj = ws.ChartObjects.Add(Left:=300, Top:=50, Width:=400, Height:=300)
chartObj.Chart.SetSourceData Source:=pt.TableRange2
chartObj.Chart.ChartType = xlColumnClustered
chartObj.Chart.HasTitle = True
chartObj.Chart.ChartTitle.Text = pt.Name & " グラフ"
' グラフをコピーして統合ブックに貼り付け
chartObj.Copy
destWs.Paste destWs.Range("A" & pasteTop)
pasteTop = pasteTop + 20
' 作成したグラフを削除（元ブックを汚さないように）
chartObj.Delete
End If
Next pt
End If
Next ws
End If
Next wb
End Sub
👉 開いているすべてのブックから「Data」シートにある 数量ピボット と 売上ピボット をグラフ化し、そのグラフを「PivotMaster.xlsx」の「Export」シートに順次貼り付けます。
応用例1：セルの値で判定してグラフ化・エクスポート
Sub セル値でピボットグラフエクスポート()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim destWb As Workbook
Dim destWs As Worksheet
Dim chartObj As ChartObject
Dim pasteTop As Long
Set destWb = Workbooks("PivotMaster.xlsx")
Set destWs = destWb.Sheets("Export")
pasteTop = 20
For Each wb In Application.Workbooks
For Each ws In wb.Worksheets
' A1セルが「グラフ化」と書かれていたら対象
If ws.Range("A1").Value = "グラフ化" Then
For Each pt In ws.PivotTables
Set chartObj = ws.ChartObjects.Add(Left:=300, Top:=50, Width:=400, Height:=300)
chartObj.Chart.SetSourceData Source:=pt.TableRange2
chartObj.Chart.ChartType = xlPie
chartObj.Chart.HasTitle = True
chartObj.Chart.ChartTitle.Text = pt.Name & " グラフ"
chartObj.Copy
destWs.Paste destWs.Range("A" & pasteTop)
pasteTop = pasteTop + 20
chartObj.Delete
Next pt
End If
Next ws
Next wb
End Sub
応用例2：複数条件を組み合わせてグラフ化・エクスポート
Sub 複数条件でピボットグラフエクスポート()
Dim wb As Workbook
Dim ws As Worksheet
Dim pt As PivotTable
Dim destWb As Workbook
Dim destWs As Worksheet
Dim chartObj As ChartObject
Dim pasteTop As Long
Set destWb = Workbooks("PivotMaster.xlsx")
Set destWs = destWb.Sheets("Export")
pasteTop = 20
For Each wb In Application.Workbooks
For Each ws In wb.Worksheets
' 条件1: シート名が「Sales」で始まる
' 条件2: B2セルが100以上
If Left(ws.Name, 5) = "Sales" And ws.Range("B2").Value >= 100 Then
For Each pt In ws.PivotTables
If InStr(pt.Name, "数量") > 0 Or InStr(pt.Name, "売上") > 0 Then
Set chartObj = ws.ChartObjects.Add(Left:=300, Top:=50, Width:=400, Height:=300)
chartObj.Chart.SetSourceData Source:=pt.TableRange2
chartObj.Chart.ChartType = xlLine
chartObj.Chart.HasTitle = True
chartObj.Chart.ChartTitle.Text = pt.Name & " グラフ"
chartObj.Copy
destWs.Paste destWs.Range("A" & pasteTop)
pasteTop = pasteTop + 20
chartObj.Delete
End If
Next pt
End If
Next ws
Next wb
End Sub
ポイント
- ピボット結果をグラフ化 →
ChartObjects.Add+Chart.SetSourceData - 複数種類を同時対象 → 名前に「数量」「売上」などを含めて判定
- 統合先ブックにコピー →
chartObj.Copy→destWs.Paste - 条件判定 → シート名やセルの値を使って柔軟に設定
練習課題
- 全ブックの「Sheet2」にある複数ピボットを棒グラフにして「PivotMaster.xlsx」にまとめる
- 各シートのC1セルが「Export」と書かれていたら複数ピボットを円グラフにしてまとめる
- 複数条件を組み合わせて「シート名がReportで始まり、A1セルが空でないなら数量・売上ピボットを折れ線グラフにしてまとめる」コードを作る
こうした仕組みを作ると、複数ブックにまたがって条件付きでピボットテーブルを複数種類同時にグラフ化してエクスポートする自動化ツールが完成します。
