ピボットテーブルの備忘録　⑦テーブル作成部分だけを単独でメソッド化

先日から、マクロによるピボットテーブルの扱いを纏めている（備忘録）。
昨日は、指定した範囲を一旦テーブル化し、そのテーブルからピボットテーブルを作成してみた。
infoment.hatenablog.com

今回は、昨日作成したもののうち、テーブル化する部分だけを切り分けてみた。
f:id:Infoment:20200328225747p:plain

ということで、切り分けたのがこちら。

' ピボットテーブル作成。
Public Function MakePivotTable(source As Variant, _
                      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
        
    Dim SourceTable As ListObject
        ' sourceのType確認。
        Select Case TypeName(source)
            
            ' テーブルの場合。
            Case "ListObject"
                Set SourceTable = source
            
            ' シート上の範囲が指定された場合。
            Case "Range"
            
                ' 範囲に設定されたテーブルをsource_dataにセット。
                Set SourceTable = source.ListObject
                
                ' テーブルが存在しない場合、選択範囲から得られるCurrentRegionの範囲を
                ' テーブルに置き換える。
                If SourceTable Is Nothing Then
                    Set SourceTable = MakeTable(source.CurrentRegion)
                End If
        End Select
    
    On Error GoTo er:
    Set Pvt = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
                                                SourceData:=SourceTable, _
                                                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

Public Function MakeTable(source_range As Range) As ListObject
    Set MakeTable = source_range.Parent.ListObjects.Add(xlSrcRange, source_range, , xlYes)
        With MakeTable
            .Name = "Table_" & Format(Now, "yyyymmdd_hhmmss")
            .TableStyle = SetPersonalTableStyle
            With .Range.Cells
                .Font.Name = "メイリオ"
                .Font.Size = 10
                .RowHeight = 20
                .EntireColumn.AutoFit
            End With
        End With
End Function