Sub CreatePivotTableWithPrompt()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pc As PivotCache
Dim rngData As Range
Dim rngDest As Range
Dim response As VbMsgBoxResult
' データ範囲を指定します。適切に変更してください。
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set rngData = ws.Range("A1:D100") ' データの範囲を指定
' ユーザーに確認メッセージを表示し、選択させます。
response = MsgBox("どの書式でピボットテーブルを作成しますか?" & vbCrLf & _
"現在のピボットテーブルの書式: 「はい」を選択" & vbCrLf & _
"従来のピボットテーブルの書式: 「いいえ」を選択", vbYesNoCancel, "書式の選択")
If response = vbCancel Then Exit Sub ' キャンセルが選択された場合、処理を終了します。
' ピボットテーブルを配置する場所を指定します。適切に変更してください。
Set rngDest = ws.Range("F1")
' ピボットキャッシュを作成します。
Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngData)
' ピボットテーブルを作成します。
If response = vbYes Then
' 現在のピボットテーブルの書式で作成
Set pt = rngDest.PivotTableWizard(TableDestination:=rngDest, TableName:="PivotTable1", SourceType:=xlDatabase, SourceData:=rngData)
ElseIf response = vbNo Then
' 従来のピボットテーブルの書式で作成
Set pt = rngDest.PivotTableWizard(TableDestination:=rngDest, TableName:="PivotTable1", SourceType:=xlDatabase, SourceData:=rngData, DefaultVersion:=xlPivotTableVersion10)
End If
' ピボットテーブルのフィールドを配置します。適切に変更してください。
With pt
.PivotFields("Field1").Orientation = xlRowField ' 行フィールドに配置
.PivotFields("Field2").Orientation = xlColumnField ' 列フィールドに配置
.PivotFields("Field3").Orientation = xlDataField ' データフィールドに配置
End With
End Sub