スライサーを戻り値とする関数でタイムラインも作成

昨日は、テーブルでスライサーを作成する関数について、ピボットテーブルからも作れるようにしてみた。
infoment.hatenablog.com

今日は、昨日の続きから。

スライサーを追加して思った。ついでに、タイムラインも追加したい。
調べてみると、スライサー作成時のこちらの引数で、スライサーにするか
タイムラインにするかを選べるらしい。

SlicerCacheType

ということで、こんな仕様を追加してみた。

1. スライサーとタイムラインを選択可とする。
2. タイムラインは、「年・月・日・四半期」を選択可とする。
3. 日を選んだ場合、開始日と終了日を選択可とする。
4. 開始日と終了日の指定が無い場合、当月の初日から最終日とする。

具体的には、↓ こんな感じだ。

' スライサー追加。
Public Function AddedSlicer(source As Variant, _
                            target_label As String, _
                   Optional destination_sheetname As String, _
                   Optional slicer_cache_type As Excel.XlSlicerCacheType = xlSlicer, _
                   Optional timeline_viewstate_level As Excel.XlTimelineLevel = xlTimelineLevelDays, _
                   Optional timeline_start As Date, _
                   Optional timeline_end As Date) As Excel.Slicer
    
    ' スライサーの追加先。
    Dim Sh As Worksheet
        Select Case destination_sheetname
            Case vbNullString
                Set Sh = ActiveSheet
            Case Else
                Set Sh = Sheets(destination_sheetname)
        End Select
    
    ' sourceの型によって処理を変更。
    Dim SourceTable As Variant
        Select Case TypeName(source)
            Case "ListObject", "PivotTable"
                Set SourceTable = source
            Case "Range"
                
                ' sourceがテーブルの一部なのか、ピボットテーブルの一部なのかを判別。
                ' 異なる型で設定するとエラーになるため、一時的にエラーを無視させる。
                On Error Resume Next
                Dim Tb As ListObject: Set Tb = source.ListObject
                Dim Pt As PivotTable: Set Pt = source.PivotTable
                    If Tb Is Nothing Then
                        If Not Pt Is Nothing Then
                            Set SourceTable = Pt
                        Else
                            Exit Function
                        End If
                    Else
                        Set SourceTable = Tb
                    End If
                On Error GoTo 0
            Case Else
                Exit Function
        End Select
    
    ' スライサーキャッシュまでで、一旦変数に格納する（コードの一行が長くなるので）。
    Dim SlicerCache As Excel.SlicerCache
    
    ' スライサーキャッシュの名前が既存のものと重複した場合、自動で末尾に数字が付される（カウントアップ）。
    Set SlicerCache = ActiveWorkbook.SlicerCaches.Add2(SourceTable, target_label, , slicer_cache_type)
                       
    ' スライサーの名前が重複すると、エラーになる。重複を避けるために、名前に年月日_時分秒を追加する。
    Set AddedSlicer = SlicerCache.Slicers.Add(Sh, , target_label & Format(Now, "_yyyymmdd_hhmmss"), target_label)
    
    ' スライサーがタイムラインの場合の設定
        If slicer_cache_type = xlTimeline Then
        
            ' タイムラインのレベルを「年、四半期、月、日」の何れかに設定する。
            AddedSlicer.TimelineViewState.Level = timeline_viewstate_level
            
            ' タイムラインのレベルが「日」である場合に限り、表示の開始日と終了日を設定する。
            ' ※年単位でデータがある場合、無駄に長くなってしまうため。
            If timeline_viewstate_level = xlTimelineLevelDays Then
            
                ' 開始日の指定がない場合、当月一日とする。
                If timeline_start = Empty Then
                    timeline_start = Format(Date, "yyyy/mm/01")
                End If
                
                ' 終了日の指定がない場合、当月最終日とする。
                If timeline_end = Empty Then
                    timeline_end = WorksheetFunction.EDate(timeline_start, 1) - 1
                End If
                
                ' 開始日と終了日の前後関係が逆転している場合、全てのデータが表示される。
                ' そこで大小関係を確認・調整している。
                If timeline_start > timeline_end Then
                    Dim temp As Date: temp = timeline_start
                    timeline_start = timeline_end
                    timeline_end = temp
                End If
                
                ' タイムラインのデータ範囲設定。
                SlicerCache.TimelineState.SetFilterDateRange timeline_start, timeline_end
            End If
        End If
End Function

ちょっと長くなったが、使ってみると中々いい感じだ。
早速、↓ こちらも併せて更新するとしよう。
infoment.hatenablog.com

以上、参考まで。