ピボットテーブルのボディ部+αに名前をつける

ピボットテーブルのボディ部+αに、名前をつけたくなった。さて、どうしたものか。
f:id:Infoment:20200521223220j:plain

今回名前をつけたくなったのは、この部分だ。
f:id:Infoment:20200521223340p:plain

DataBodyRangeでは、この部分しか選択されない。
f:id:Infoment:20200521223601p:plain

RowRangeプロパティだと、ここ。やっぱり足りない。
f:id:Infoment:20200521223801p:plain

ということで、仕方ない。かなり回り道になったが、こんな風にしてみた。
※今回は、シートモジュールに記載している。

' ピボットテーブル。
Private Property Get Pvt() As PivotTable
    Set Pvt = Me.PivotTables(1)
End Property

' 欲しい範囲を設定。
Private Property Get NameTargetRange() As Range
    ' ① まずRowRangeをテーブルの列分だけ拡張。
    Set NameTargetRange = Pvt.RowRange.Resize(, Pvt.TableRange1.Columns.Count)
    ' ② ラベルと総計は不要なので、下にずらして上に詰めている。
    Set NameTargetRange = NameTargetRange.Offset(1).Resize(NameTargetRange.Rows.Count - 2)
End Property

Sub 名前付け()
    ActiveWorkbook.Names.Add Name:="テスト", _
                             RefersToR1C1:="=" & NameTargetRange.Address(, , xlR1C1)
End Sub

結果、一応目的の個所に名前は付いた。
f:id:Infoment:20200521224316p:plain

しかし・・・もっとスマートな方法は無いものか?

引き続き模索します。

参考まで。