ピボットテーブルの備忘録 ② クラス化（１）器を準備

先日から、マクロによるピボットテーブルの扱いを纏めている（備忘録）。
infoment.hatenablog.com

毎回毎回、手間をかけて作っていたが、いい加減面倒になってきた。
そこでこれを機に、部品化してしまおうと思う。備忘録と言いながら、
今回は開発要素が強いシリーズになりそうだ。

昨日マクロの記録で作成したコードのうち、最初の部分を抜き出してみよう。
※Pvtversionを除く。

Sub Macro2()
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Table_20200302_235127", Version:=PvtVersion).CreatePivotTable TableDestination:= _
        "Sheet2!R3C1", TableName:="ピボットテーブル11", DefaultVersion:=PvtVersion
End Sub

個人使用の部品であるから、ある程度の汎用性は犠牲にしても良いと思っている。今回の例で言えば、ピボットテーブルは必ずテーブルから作成すると決めてみる。

するとSource（つまり元ネタ）のタイプは必ずデータベース（xlDatabase）であるから、この部分は固定でよくなる。

SourceType:=xlDatabase

ということは、毎回必要になる情報は、

• どのテーブルから作成するか
• どこに作るか
• テーブルの名前をどうするか

の３本です、となる。

クラスモジュール（PvtTable）

Option Explicit

Public Pvt As Excel.PivotTable

Public Function MakePivotTable(source_data As ListObject, _
                      Optional sheet_name As String = vbNullString, _
                      Optional table_destination As String = "R3C1", _
                      Optional table_name As String = vbNullString) _
                      As Boolean
    
    ' 以下の場合、新規にシートを作成する。
    ' ① 指定された名前のシートが存在しない場合。
    ' ② シートの指定が無い場合。
    Dim Sh As Worksheet
    Dim Ws As Worksheet
        If sheet_name = vbNullString Then
            Set Sh = Sheets.Add
                ' シート名が無指定の場合、重複しないよう日付で命名。
                Sh.Name = "SheetForPivot_" & Format(Now, "yyyymmdd_hhmmss")
        Else
            ' 指定された名前のシートを探し、
            ' 見つかればShにセットする。
            For Each Ws In Worksheets
                If Ws.Name = sheet_name Then
                    Set Sh = Ws
                    Exit For
                End If
            Next
            ' 見つからなければ、新規に作成する。
            If Sh Is Nothing Then
                Set Sh = Sheets.Add
                    Sh.Name = sheet_name
            End If
        End If
        
        ' ピボットテーブル名が無指定の場合、重複しないように日付で命名。
        If table_name = vbNullString Then
            table_name = "PivotTable_" & Format(Now, "yyyymmdd_hhmmss")
        End If
    
    On Error GoTo er:
    Set Pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                                SourceData:=source_data, _
                                                Version:=PvtVersion).CreatePivotTable _
                    (TableDestination:=Sh.Name & "!" & table_destination, _
                     TableName:=table_name, _
                     DefaultVersion:=PvtVersion)
        
        ' ピボットテーブル作成成功。
        MakePivotTable = True
        Exit Function
er:
        ' ピボットテーブル作成失敗。
        MakePivotTable = False
        On Error GoTo 0
End Function

Private Property Get PvtVersion() As Long
    Select Case CLng(Application.Version)
        ' 2010の場合。
        Case 14
            PvtVersion = xlPivotTableVersion14
        ' 2013の場合。
        Case 15
            PvtVersion = xlPivotTableVersion15
        ' 2016の場合。
        Case 16
            PvtVersion = 6
    End Select
End Property

今回は取り敢えず、空っぽのピボットテーブルを作成するところまで。
ついでに、成功すればTrueを、失敗したらFalseを返すことにしてみた。

では、こちらでテストしてみよう。

Sub Test()
    Dim PvtTable As VBAProject.PvtTable
    Set PvtTable = New VBAProject.PvtTable
    
    Dim Pvt As Excel.PivotTable
        If PvtTable.MakePivotTable(ActiveSheet.ListObjects(1)) Then
            Set Pvt = PvtTable.Pvt
        End If
End Sub

とりあえず、器は出来た。

明日に続きます。

参考まで。