★Access2000VBA・Excel2000VBA独学～Access2019のクエリをソースに、COMオートメーションでExcel2019のファイルを自動生成し、ピボットも自動生成する方法～

★Access2000VBA・Excel2000VBA独学～Access2019のクエリをソースに、COMオートメーションでExcel2019のファイルを自動生成し、ピボットも自動生成する方法～
　　
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。
　　
　　

★ はじめに

まさかAccess2019でピボットテーブルが作れなくなっているとは知りませんでした。

ピボットテーブルは集計がしやすいのでAccessと切っても切れない関係です。

Accessには「クロス集計クエリ」というものがあるのですが、１段階の列名や行名ならウィザードやあるいはクエリのデザイングリッドで簡単に作れるのですが、２段階以上の列名や行名になると、SQLを深く知らないと作れません。（知っててもできるかどうかわかりませんけど・・・。多分できるとは思うんですけど・・・）

その点、ピボットテーブルはSQLを知らなくても、誰でも簡単に、何段階もの列名や行名を持ったクロス集計表が作成できます。

もともと、バージョン2000のときも、Accessのピボットテーブルは使い勝手が良くなかったり、ファイルの肥大化の原因になったりしたので、ピボットはExcel側で作っていました。（ただ、先に前もって作ってあった xlsファイルの中のピボットの内容変更だけでしたが）

ですので、今回もそのような形で「Excelファイルの新規作成」と「その中のシートへのピボットテーブルの新規作成」のプログラムを作ってみたいと思います。

すでに存在する「Accessのクエリをソースにしたピボット」のソースのSQL内容を変える・・・ということはやったことがあったのですが、新規に作る、ということはしたことがなかったので、今回、実験してみました。

実験なので、間違っている部分もあるかもしれませんが、何かのご参考になれば。

★ マクロの記録のコードを流用した、もっとも簡単な方法の実験

僕も良く分からないのですみませんが、以下のような流れてサンプルを作ることができました。

(01)『 Accessファイル（accdb形式）のクエリをソースにしたピボットを、Excel2019上で作成する』その流れを、マクロの記録機能にてマクロを作成

(02)そのコードを流用して、COMオートメーションにて、AccessからExcelファイルを自動生成し、そこにピボットが生成されるようにする
　　

ピボットがらみのコードは、ヘルプにも、「結構複雑になるのでマクロの記録を利用して作ってください」的なことが書いてあるので、基本、このようなやりかたでOKです。
（あとこちらの神サイトもご参考に→雨のち晴れ

上記の(01)により生成したExcelのコードを使ってAccessで動くように修正した・・・、つまり「Accessで動かすプログラム」のコードは以降の「test002()」のようになりました。
Excelファイルが生成されてすぐあとに、途中で、添付画像のようなダイアログが出ますが、そのままOKしたらExcelファイルの中にピボットが自動生成されました。

長いので、「 '生成されたピボットテーブルの各種設定？」のところ（「'Excelファイルの最初の保存」の直前まで）の各種設定は、全部消すか、コメントアウトしても動くと思います。

※※ 事前にMicrosoft Excel 16.0 Object Library に参照設定をしてから実行します。
　なお、複数のバージョンのExcelを共依存させていると、エラーで動かないかもです。
　また、ご自分の環境に合わせて「★ 設定部」のところのクエリ名を変えてください。
　クエリとテーブルが使えます（どちらの名前でもOKです。）。

'
'
Sub test002()

    '★Microsoft Excel 16.0 Object Library に
    ' 参照設定をしてから実行します。

    Dim xlappGawa       As Excel.Application
    Dim xlBook01        As Workbook
    Dim DbFullPath      As String
    Dim SrcQryName      As String
    Dim TrgCellAddress  As String
    

    'Excelファイルの生成と表示
    Set xlappGawa = New Excel.Application
    xlappGawa.Visible = True
    Set xlBook01 = xlappGawa.Workbooks.Add
    
    
    'Accessファイルのフルパスのゲット
    DbFullPath = CurrentDb.Name
    
    
    ★ 設定部

    'ピボットのソースにするクエリの名前の指定
    SrcQryName = "q_t1"
    
    
    'Excelファイルの、ピボットを生成したいセルの位置
    '（R1C1形式のアドレス）
    TrgCellAddress = "R1C1"
    

    ★ 実働部

    'ExcelファイルからAccessファイルへ接続？
    xlBook01.Connections.Add "db2", "", _
        Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & DbFullPath & ";Mode=Share Deny Write;Extended Properties" _
        , _
        "="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Dat" _
        , _
        "abase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password=""""" _
        , _
        ";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:" _
        , _
        "Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validati" _
        , _
        "on=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _
        ), _
        SrcQryName, 3
        
        
    'ピボットキャッシュとピボットテーブルの同時生成
    xlBook01.PivotCaches.Create( _
        SourceType:=xlExternal, _
        SourceData:=xlBook01.Connections("db2"), _
        Version:=6). _
        CreatePivotTable _
        TableDestination:="Sheet1!" & TrgCellAddress, _
        TableName:="ピボットテーブル1", _
        DefaultVersion:=6
        
        
    
    'この時点で、なぜかダイアログボックスが出るので「OK」ボタンを押します。
    '数秒待ってからゆっくりでないと、なぜか最後のファイル保存でエラーで保存できませんでした。
        

    
    '生成されたピボットテーブルの各種設定？
    With xlBook01.ActiveSheet.PivotTables("ピボットテーブル1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = True
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    
    With xlBook01.ActiveSheet.PivotTables("ピボットテーブル1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    
    xlBook01.ActiveSheet.PivotTables("ピボットテーブル1").RepeatAllLabels xlRepeatLabels
    
    
    
    'Excelファイルの最初の保存
'    ChDir "D:\1"
    ActiveWorkbook.SaveAs FileName:="D:\1\PvtTset.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 
End Sub
'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

Sub test002()

'★Microsoft Excel 16.0 Object Library に

' 参照設定をしてから実行します。

Dim xlappGawa As Excel.Application

Dim xlBook01 As Workbook

Dim DbFullPath As String

Dim SrcQryName As String

Dim TrgCellAddress As String

'Excelファイルの生成と表示

Set xlappGawa = New Excel.Application

xlappGawa.Visible = True

Set xlBook01 = xlappGawa.Workbooks.Add

'Accessファイルのフルパスのゲット

DbFullPath = CurrentDb.Name

★ 設定部

'ピボットのソースにするクエリの名前の指定

SrcQryName = "q_t1"

'Excelファイルの、ピボットを生成したいセルの位置

'（R1C1形式のアドレス）

TrgCellAddress = "R1C1"

★ 実働部

'ExcelファイルからAccessファイルへ接続？

xlBook01.Connections.Add "db2", "", _

Array( _

"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & DbFullPath & ";Mode=Share Deny Write;Extended Properties" _

, _

"="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Dat" _

, _

"abase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password=""""" _

, _

";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:" _

, _

"Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validati" _

, _

"on=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _

), _

SrcQryName, 3

'ピボットキャッシュとピボットテーブルの同時生成

xlBook01.PivotCaches.Create( _

SourceType:=xlExternal, _

SourceData:=xlBook01.Connections("db2"), _

Version:=6). _

CreatePivotTable _

TableDestination:="Sheet1!" & TrgCellAddress, _

TableName:="ピボットテーブル1", _

DefaultVersion:=6

'この時点で、なぜかダイアログボックスが出るので「OK」ボタンを押します。

'数秒待ってからゆっくりでないと、なぜか最後のファイル保存でエラーで保存できませんでした。

'生成されたピボットテーブルの各種設定？

With xlBook01.ActiveSheet.PivotTables("ピボットテーブル1")

.ColumnGrand = True

.HasAutoFormat = True

.DisplayErrorString = False

.DisplayNullString = True

.EnableDrilldown = True

.ErrorString = ""

.MergeLabels = False

.NullString = ""

.PageFieldOrder = 2

.PageFieldWrapCount = 0

.PreserveFormatting = True

.RowGrand = True

.SaveData = True

.PrintTitles = False

.RepeatItemsOnEachPrintedPage = True

.TotalsAnnotation = False

.CompactRowIndent = 1

.InGridDropZones = False

.DisplayFieldCaptions = True

.DisplayMemberPropertyTooltips = False

.DisplayContextTooltips = True

.ShowDrillIndicators = True

.PrintDrillIndicators = False

.AllowMultipleFilters = False

.SortUsingCustomLists = True

.FieldListSortAscending = True

.ShowValuesRow = False

.CalculatedMembersInFilters = False

.RowAxisLayout xlCompactRow

End With

With xlBook01.ActiveSheet.PivotTables("ピボットテーブル1").PivotCache

.RefreshOnFileOpen = False

.MissingItemsLimit = xlMissingItemsDefault

End With

xlBook01.ActiveSheet.PivotTables("ピボットテーブル1").RepeatAllLabels xlRepeatLabels

'Excelファイルの最初の保存

' ChDir "D:\1"

ActiveWorkbook.SaveAs FileName:="D:\1\PvtTset.xlsm", FileFormat:= _

xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

　　
プログラムの途中で出てくるダイアログは以下のようなものでした。
これをそのままOKします。
多分接続文字列で何らかの記述を変更・あるいは追加すれば、出なくなるのではないかと推測されます。

　　
ちなみにですが、このダイアログ画面がでるのは、『ピボットのソースとなるテーブルやクエリを保持しているaccdb 』が開いていると出てきます。
閉じている時は出ずに、すんなりピボットが作成されます。

つまり、『ピボットのソースとなるテーブルやクエリを保持しているaccdb 』は閉じておいて、さらに別のaccdbから、上記のプログラムを実行すると、すんなりピボットが作成されます。

逆に、『ピボットのソースとなるテーブルやクエリを保持しているaccdb 』にて、直接、上記のプログラムを実行すると、このダイアログが出てきます。
また、更なる別のaccdbからプログラムを実行しても、問題のそのソースのaccdbを（何らかの理由で）閉じ忘れていると、同じようにこのダイアログが出てきます。

ご注意下さい。

なお、このプログラムは、他のバージョンのExcelが入っていると動かないかもしれません。※※ （当方では2010と2019が混在するマシンでは動きませんでした。）

もちろん、2019オンリーのマシンでは動きました。
（旧Office365 Solo ＝現Microsoft365 Psesonalの2019です。）

また、1004 のアプリケーション定義エラーが出るかもしれません。
その際は、ご自身の状況に合わせて、後述のようなExcelでの「ピボットを作るマクロ」を１つ作って、それをExcel上で実行してから上記コードを実行するとエラーが出なくなるかもしれません。

どうしても1004エラーが消えない場合は、さらに後述する、「ちょっとめんどくさいですけどエラーの出ない方法」でやる、という選択肢もあります。

ダイアログが出てもいいなら、上記のようにマクロコードをそのまま「ほぼほぼ流用」してしまうのが一番ラクちんです。

なお、ピボット作成のマクロの記録のコードは、バージョンによって内容が変わるので、そこも注意が必要です。

上記のコードは2019で作ったマクロの記録のコードを流用しているので2019でしか動かないかもです。
マクロ記録でコードを一度ご自分で生成して、それを上記の例を参考に作り変えるなどしてみてください。

なお、「ピボットテーブル1」というのは生成するピボットの名前ですが、必要に応じてこれも変数化して、
「臨機応変に異なる名前を付けられるようにする」・・・
といいかもしれません。
たとえば、１シート、1ブック、の中に複数のピボットを作りたい場合とかは・・・。

＊＊＊＊＊＊＊＊＊＊

'ExcelファイルからAccessファイルへ接続？
xlBook01.Connections.Add "db2", "", _

の部分の、

「 "db2" 」はどんな名前でも良いっぽいです。

なので、これも必要に応じて好きな名前に変えられるようにしても良いかもしれません。
　　

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

あと、以下は、マクロの記録で生成されたコードです。
今回はこれをベースにして、このコードを少し修正したものをAccess上にて動かしています。
Accessから動かす場合は、Excelファイルにはプログラムは1行も書きません。
ご参考まで。

※Accessで1004エラーが出る場合は、以下のようなコードを、ご自身で「マクロの記録」でつくることができますので、作ったのち、それをいったん実行すると、Accessで実行する時に1004エラーが出なくなるかもしれません。
　　

'
'
Sub Macro3()
'
' Macro1 Macro
'

'
    Workbooks("book1").Connections.Add2 "db2", "", Array( _
        "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=D:\1\db2.accdb;Mode=Share Deny Write;Extended Properties" _
        , _
        "="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Dat" _
        , _
        "abase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password=""""" _
        , _
        ";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:" _
        , _
        "Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validati" _
        , _
        "on=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _
        ), "q_t1", 3
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _
        ActiveWorkbook.Connections("db2"), Version:=6).CreatePivotTable _
        TableDestination:="Sheet1!R1C1", TableName:="ピボットテーブル1", DefaultVersion:= _
        6
    Cells(1, 1).Select
    With ActiveSheet.PivotTables("ピボットテーブル1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = True
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("ピボットテーブル1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("ピボットテーブル1").RepeatAllLabels xlRepeatLabels
    ChDir "D:\1"
 '   ActiveWorkbook.SaveAs Filename:="D:\1\pvttset.xlsm", FileFormat:= _
 '       xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
'
'

Sub Macro3()

' Macro1 Macro

Workbooks("book1").Connections.Add2 "db2", "", Array( _

"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=D:\1\db2.accdb;Mode=Share Deny Write;Extended Properties" _

, _

"="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=6;Jet OLEDB:Dat" _

, _

"abase Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password=""""" _

, _

";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:" _

, _

"Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validati" _

, _

"on=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _

), "q_t1", 3

ActiveWorkbook.PivotCaches.Create(SourceType:=xlExternal, SourceData:= _

ActiveWorkbook.Connections("db2"), Version:=6).CreatePivotTable _

TableDestination:="Sheet1!R1C1", TableName:="ピボットテーブル1", DefaultVersion:= _

Cells(1, 1).Select

With ActiveSheet.PivotTables("ピボットテーブル1")

.ColumnGrand = True

.HasAutoFormat = True

.DisplayErrorString = False

.DisplayNullString = True

.EnableDrilldown = True

.ErrorString = ""

.MergeLabels = False

.NullString = ""

.PageFieldOrder = 2

.PageFieldWrapCount = 0

.PreserveFormatting = True

.RowGrand = True

.SaveData = True

.PrintTitles = False

.RepeatItemsOnEachPrintedPage = True

.TotalsAnnotation = False

.CompactRowIndent = 1

.InGridDropZones = False

.DisplayFieldCaptions = True

.DisplayMemberPropertyTooltips = False

.DisplayContextTooltips = True

.ShowDrillIndicators = True

.PrintDrillIndicators = False

.AllowMultipleFilters = False

.SortUsingCustomLists = True

.FieldListSortAscending = True

.ShowValuesRow = False

.CalculatedMembersInFilters = False

.RowAxisLayout xlCompactRow

End With

With ActiveSheet.PivotTables("ピボットテーブル1").PivotCache

.RefreshOnFileOpen = False

.MissingItemsLimit = xlMissingItemsDefault

End With

ActiveSheet.PivotTables("ピボットテーブル1").RepeatAllLabels xlRepeatLabels

ChDir "D:\1"

' ActiveWorkbook.SaveAs Filename:="D:\1\pvttset.xlsm", FileFormat:= _

' xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

★ Excel2000のマクロの記録のコードを流用する実験

実験して見ましたらExcel2000のピボット作成のマクロ記録のコードがなぜか2019でも、つまり、「accdb」拡張子のファイルに対しても使えてしまいました。（「mdb」ではなくて。）

Excel2000のピボット作成のマクロのコードは、ソースにSQLを使うので、色々といじれて便利なうえに、2019のマクロコードよりもシンプルなのでおススメかもしれません。
（もちろん、2019のVBAコードでもSQLを使えるはずですが。ただ、他の項目が多すぎて長いのでここではちょっとヤメにしておきます。）

ただ、このコードでもaccdbに載せ替えると例のダイアログが出てきます。
ただ、2019のマクロコードの場合と違って、出てくるダイアログをOKしても進まないので、これは完全に・・・、さらに後述する、「ちょっとめんどくさいですけどエラーの出ない方法」でやる・・・、という選択肢しか無いかもしれません。

もちろん、「ソースのテーブルやクエリが格納されたaccdb」を閉じておいて、さらに他のaccdbから実行すれば、ダイアログは出ず、すんなり、新規Excelファイルもピボットも生成されます。
　　
　　
それはさておき・・・、
ここではとりあえず、その「Excel2000のマクロの記録」で生成された最初のコードをご提示します。
ここではまずは、accdbじゃなくてmdbに接続しに行ってます。
また、ピボットは自ファイル内のアクティブシートに作っています。

'
'
'Excel2000にて、accdbじゃなくて、mdbに接続しにいって、ピボットを作る過程を、マクロ記録したモノ
'※自ファイル内のアクティブシートにピボットを作っています。

'2019のマクロの記録のコードよりも、圧倒的に少ないです。

Sub Macro2()

'
    With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        .Connection = _
        "ODBC;DSN=MS Access Database;DBQ=D:\1\tes001old.mdb;DefaultDir=D:\1;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
        .CommandType = xlCmdSql
        .CommandText = Array( _
        "SELECT t01.PK, t01.F01, t01.F02, t01.F03, t01.F04, t01.F05" & Chr(13) & "" & Chr(10) & "FROM `D:\1\tes001old`.t01 t01" _
        )
        .CreatePivotTable TableDestination:=Range("A3"), TableName:= _
        "ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1"
    End With
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").SmallGrid = False
    
End Sub
'
'

'Excel2000にて、accdbじゃなくて、mdbに接続しにいって、ピボットを作る過程を、マクロ記録したモノ

'※自ファイル内のアクティブシートにピボットを作っています。

'2019のマクロの記録のコードよりも、圧倒的に少ないです。

Sub Macro2()

With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)

.Connection = _

"ODBC;DSN=MS Access Database;DBQ=D:\1\tes001old.mdb;DefaultDir=D:\1;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"

.CommandType = xlCmdSql

.CommandText = Array( _

"SELECT t01.PK, t01.F01, t01.F02, t01.F03, t01.F04, t01.F05" & Chr(13) & "" & Chr(10) & "FROM `D:\1\tes001old`.t01 t01" _

)

.CreatePivotTable TableDestination:=Range("A3"), TableName:= _

"ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1"

End With

ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").SmallGrid = False

End Sub

　　
次に、上記のコードをほぼ「まんま」で、少し手直しして、「D:\1\PvtSrcDB.accdb」というaccdbファイルの中の「t1」という名前のテーブルに接続しに行ってみます。
以下のようなコードになります。
（書き変えたのは「Connection 」の「DBQ」のaccdbのフルパスと、「CommandText 」のSQL内容だけです。）

'
'
'それを少し書き換えて、accdbに接続しにいって、ピボットを作れるように改造したモノ
'※こちらも自ファイル内のアクティブシートにピボットを作っています。

'2000用に作ったのに、2019でもちゃんと動いてしまいました。
'なので、2019のピボットのマクロはやめて、こちらを使うことにします。

Sub Macro2_02()

'
    With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)
        .Connection = _
        "ODBC;DSN=MS Access Database;DBQ=D:\1\PvtSrcDB.accdb;DefaultDir=D:\1;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM t1")
        .CreatePivotTable TableDestination:=Range("A3"), TableName:= _
        "ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1"
    End With
    ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").SmallGrid = False
    
End Sub

'
'

'それを少し書き換えて、accdbに接続しにいって、ピボットを作れるように改造したモノ

'※こちらも自ファイル内のアクティブシートにピボットを作っています。

'2000用に作ったのに、2019でもちゃんと動いてしまいました。

'なので、2019のピボットのマクロはやめて、こちらを使うことにします。

Sub Macro2_02()

With ActiveWorkbook.PivotCaches.Add(SourceType:=xlExternal)

.Connection = _

"ODBC;DSN=MS Access Database;DBQ=D:\1\PvtSrcDB.accdb;DefaultDir=D:\1;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"

.CommandType = xlCmdSql

.CommandText = Array("SELECT * FROM t1")

.CreatePivotTable TableDestination:=Range("A3"), TableName:= _

"ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1"

End With

ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").SmallGrid = False

End Sub

さらにこれを少し書き換えて、もう少しだけ汎用的な雰囲気にしてみます。
これは「新規」のブックを生成し、その中のシートに、
「accdbファイルの中のクエリ」をのぞきにいったピボットを作成しています。
サンプルでは、「d:\1\PvtMakeTest01.accdb というファイルの ” q_t1 ” というクエリ」を
覗きに行ったピボットを生成しています。

基本、Accessのファイルを覗きに行く場合（mdbでもaccdbでも）、
「CommandText」には、テーブルもクエリもどちらでも指定できます。

'
'
'それを更に少し書き換えて、若干、汎用的に動かせるようにしやすくしたモノ。
'新規のブックを生成して、そこへ、ピボットを生成しています。

Sub test00122()

    Dim xlappGawa       As Excel.Application
    Dim xlBook01        As Workbook
    Dim s_DbFullPath    As String
    Dim s_SrcQryName    As String
'    Dim TrgCellAddress  As String
    Dim o_TrgCell       As Range
    Dim o_PvtCache01    As PivotCache
    Dim o_Pivot01       As Object

    '★ 設定部
        
    '読みに行くAccessファイルのフルパスの設定
    s_DbFullPath = "d:\1\PvtMakeTest01.accdb"
    
    
    'ピボットのソースにするクエリの名前の指定
    s_SrcQryName = "q_t1"
    
    
'    TrgCellAddress = "R1C1"
    
    
    
    '★ 実働部    

    Set xlappGawa = New Excel.Application
    xlappGawa.Visible = True
    Set xlBook01 = xlappGawa.Workbooks.Add
    '新規のExcelファイルの生成と表示       


    Set o_PvtCache01 = xlBook01.PivotCaches.Add(SourceType:=xlExternal)
    '空のピボットキャッシュの生成
    

    With o_PvtCache01
        .Connection = _
        "ODBC;DSN=MS Access Database;DBQ=" & s_DbFullPath & ";DefaultDir=D:\1;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM " & s_SrcQryName & ";")
    End With
    'ピボットキャッシュの中身の設定


    Set o_TrgCell = xlBook01.ActiveSheet.Range("A3")
    'ピボットの出力先シートとセル位置の設定            

    Set o_Pivot01 = o_PvtCache01.CreatePivotTable(TableDestination:=o_TrgCell, TableName:="ピボットテーブル1")
    'ピボットテーブルの生成        

    o_Pivot01.SmallGrid = False
    'ピボットテーブルの表示形式を古い表示に設定。    

'    With o_Pivot01
'        .HasAutoFormat = False
'        .InGridDropZones = False
'        .RowAxisLayout xlOutlineRow
'    End With
'    'ピボットテーブルの表示形式を普通の表示に設定。        

    xlBook01.ActiveSheet.Range("A3").Select
    'A3セルをアクティブにして、フィールドリストなどが
    '表示されるようにする。       
       
    
'    'Excelファイルの最初の保存
''    ChDir "D:\1"
'    xlBook01.SaveAs FileName:="D:\1\PvtTset.xlsm", FileFormat:= _
'        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'
    
End Sub
'
'

'それを更に少し書き換えて、若干、汎用的に動かせるようにしやすくしたモノ。

'新規のブックを生成して、そこへ、ピボットを生成しています。

Sub test00122()

Dim xlappGawa As Excel.Application

Dim xlBook01 As Workbook

Dim s_DbFullPath As String

Dim s_SrcQryName As String

' Dim TrgCellAddress As String

Dim o_TrgCell As Range

Dim o_PvtCache01 As PivotCache

Dim o_Pivot01 As Object

'★ 設定部

'読みに行くAccessファイルのフルパスの設定

s_DbFullPath = "d:\1\PvtMakeTest01.accdb"

'ピボットのソースにするクエリの名前の指定

s_SrcQryName = "q_t1"

' TrgCellAddress = "R1C1"

'★ 実働部

Set xlappGawa = New Excel.Application

xlappGawa.Visible = True

Set xlBook01 = xlappGawa.Workbooks.Add

'新規のExcelファイルの生成と表示

Set o_PvtCache01 = xlBook01.PivotCaches.Add(SourceType:=xlExternal)

'空のピボットキャッシュの生成

With o_PvtCache01

.Connection = _

"ODBC;DSN=MS Access Database;DBQ=" & s_DbFullPath & ";DefaultDir=D:\1;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;"

.CommandType = xlCmdSql

.CommandText = Array("SELECT * FROM " & s_SrcQryName & ";")

End With

'ピボットキャッシュの中身の設定

Set o_TrgCell = xlBook01.ActiveSheet.Range("A3")

'ピボットの出力先シートとセル位置の設定

Set o_Pivot01 = o_PvtCache01.CreatePivotTable(TableDestination:=o_TrgCell, TableName:="ピボットテーブル1")

'ピボットテーブルの生成

o_Pivot01.SmallGrid = False

'ピボットテーブルの表示形式を古い表示に設定。

' With o_Pivot01

' .HasAutoFormat = False

' .InGridDropZones = False

' .RowAxisLayout xlOutlineRow

' End With

' 'ピボットテーブルの表示形式を普通の表示に設定。

xlBook01.ActiveSheet.Range("A3").Select

'A3セルをアクティブにして、フィールドリストなどが

'表示されるようにする。

' 'Excelファイルの最初の保存

'' ChDir "D:\1"

' xlBook01.SaveAs FileName:="D:\1\PvtTset.xlsm", FileFormat:= _

' xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

★ accdbからオートメーションで上記のコードを実行すると？

2019で作ったコードのように、ダイアログボックスが表示されてしまいます。
2019と違って、ちょっと小さめの奴が。
なので、結局使えないかもですね。
　　
　　
　　

★ どのaccdbからも呼び出せるように、かつ、ダイアログが出ない「部品化」っぽくしてみる。

この場合、以下の(01)～(03)ような、3つのaccdbを使います。

(01)ピボットのソースとなるテーブル、または、クエリを持つaccdbファイル。

(02)「共用部品」のファイル。
ピボット自動生成のための各種設定を行うためのフォームを持ち、(01)のようなファイルから「参照設定」経由で呼び出され、その各種設定のフォームを表示できるようにします。
そして次項の(03)を自動起動させるプログラムも持ちます。

(03)「ピボット作成専用・その動きのみ」という役割を持つaccdbファイル。
これは、(02)から（非表示モードで）呼び出され、起動すると同時にAutoExecマクロにて、エラー回避のためにいったん(01)を閉じ、次にピボットを自動作成し、それが終わったら(01)を再度開きなおします。このファイルは非表示モードで動かして画面に映らないようにしているのですが、その理由は単に「ガチャガチャとファイルが開いたり閉じたりする」と「うっとおしい」ため、「うっとおしくないように」、という配慮のみです。
　　

以降に、(01)～(03)にて、３つともの、それぞれサンプルも作りましたのでダウンロードして中身を見てみてください。
サンプルは、基本、３つとも全部、「D:\1」というフォルダを作ってそこに置くと動きます。その他の場所に置くこともできなくはないですが、設定変更がちょっとめんどくさいです。
ただ、(01)のサンプル（PvtSrcDB.accdb）だけは、「呼び出しモト」のファイルなので、「D:\1」に置かなくても動きます。

なお、他の「呼び出しモトのAccessファイル」でもこの方法でピボットテーブルを作れるようにするには、
(02)と(03)のファイル（MidPvt.accdbとAutoPvtMake01.accdb）だけは「D:\1」というフォルダに置いて、あとは、「呼び出しモトのAccessファイル」にて　(02)の「MidPvt.accdb」に対してVBE画面で参照設定をするだけです。
「MidPvt.accdb」がアドインファイル的な働きをします。
（※「呼び出しモトのAccessファイル」＝ピボットのソースのテーブルまたはクエリを含有するAccessのファイルのことです。）

そうすれば、
「呼び出しモトのAccessファイル」に以下のコードで書くことで、
「MidPvt.accdb」の「ピボット生成の設定用のフォーム」
を呼び出せるので、
あとはピボットを自動生成できるようになります。

'
'
Call CallForm02("f_MidPvt")
'
'

Call CallForm02("f_MidPvt")

下図のように参照先ファイルのフォームを呼び出せるようになります。

　　
基本、Officeソフトに関連付けされた既定のファイル（Accessの場合ならmdb、accdb、Excelの場合ならxlsx、xlsm、ファイル）を参照設定をすると、参照先のファイルを「共用部品」として使えるようになります。
なので、例えば下図のように、『参照先のファイル、つまり、「 ” 共用部 ” とご自分で勝手に位置付けたファイル」にしか作られていない』、そいうったフォームやプログラムなどを呼び出せるようになります。
（今回のサンプルでも、呼び出しモトのファイルには上図のフォームは作ってありません）

よって、もし、すでにそういう「共用部品的」なファイルを作ってあって・かつ・参照設定もしてあるなら、「MidPvt.accdb」の内容をその中に移植してもOK、ということになります。
　　

※★重要な補足
Accessの場合でもExcelの場合でも、mdb、accdb、xlsx、xlsm、をVBEにて「参照設定」すると似たような事ができます。参照設定することでExcelで言う「アドイン」みたいなことができます。それはExcelでも同じです。
ただ、Accessのmdb、accdb、参照設定の場合は、モトとなるファイルを閉じると、参照設定先のファイルもちゃんと連動して自動的に閉じてくれますが、Excelの場合は閉じてくれない「バカ仕様」となっています。いつまでたっても改善されていません。
非表示モードにした共用ブックを、ThisWorkbookのイベントを使って、例えばAutoOpenなどでVBAで参照設定し、BeforCloseイベントでVBAで参照設定解除とファイルクローズをすればいいのかしら？
　　

そのほか、以下のように書いて、マクロから呼び出したり、「 Call OpenMidPvtForm 」で呼び出してもOKです。

'
'
Function OpenMidPvtForm()

    Call CallForm02("f_MidPvt")
        
End Function
'
'

Function OpenMidPvtForm()

Call CallForm02("f_MidPvt")

End Function

いったんAccessのファイルが閉じてしまうので「？？どうなった？」と不安になってしまうかもしれませんが、しばらく待つと下図のような感じで、Excelのピボットが自動生成されます。（下図では古いタイプの表示にVBAで設定しています。）
そしてそのあと、呼び出しモトのAccessファイルも自動的に開き直されます。

　　
　　

では、以下、(01)～(03)のファイルについての説明とサンプルです。

(01)
ピボットのソースとなるテーブル、または、クエリを持つaccdbファイル

※サンプル
https://euc-access-excel-db.com/00000WPZIP/PvtSrcDB.accdb.zip
※いったん、念のためにShiftキーを押しながら開いて、「コンテンツの有効化」を押してからいったん閉じて、それから使ってください。
　　
　　

(02)
「共用部品」のファイルです。
ピボット自動生成のための各種設定を行うためのフォームを持ち、(01)のようなファイルから「参照設定」経由で呼び出され、その各種設定のフォームを表示できるようにします。そして次項の(03)を自動起動させるプログラムも持ちます。

※サンプル
https://euc-access-excel-db.com/00000WPZIP/MidPvt.accdb.zip
※いったん、念のためにShiftキーを押しながら開いて、「コンテンツの有効化」を押してからいったん閉じて、それから使ってください。

「部品1」みたいなファイルです。
「カンタンに取り外し可能な」。
AccessもExcelと同様に、参照設定しただけで、「参照設定したファイルのプロシージャをすべて、そのファイルは ” 非表示のまま ”、 ” Call ” で呼び出すことができます」。
もちろんアドインも作れますが、アドイン作らなくてもアドインもどきが「参照設定だけで」できる・・・というイメージです。
当然、モトファイルを閉じれば、参照設定したファイルも自動的に閉じます。
何もコードを書く必要はありません。
その性質を利用します。

※Excelは参照設定したファイルは、モトファイル一緒には自動で閉じてくれません。
が、Acceessの場合はちゃんと自動でモトファイルと一緒に閉じてくれます。
また、開く際もExcelとは違って非表示モードで自動で開いてくれます。
Excelはアドインにしないと非表示かつ自動連動クローズにならないです。
でも、アドインのくせに「Call」が「できません」。
この「バカ仕様」が20年も一向に治らない理由がまったくもって意味不明です。
非表示モードにした共用ブックを、ThisWorkbookのイベントを使って、例えばAutoOpenなどでVBAで参照設定し、BeforCloseイベントでVBAで参照設定解除とファイルクローズをすればいいのかしら？
　　
　　

(03)
「ピボット作成専用・その動きのみ」という役割を持つaccdbファイルです。(02)から（非表示モードで）呼び出され、起動すると同時にAutoExecマクロにて、エラー回避のためにいったん(01)を閉じ、次にピボットを自動作成し、それが終わったら(01)を再度開きなおします。

※サンプル
https://euc-access-excel-db.com/00000WPZIP/AutoPvtMake01.accdb.zip
※いったん、念のためにShiftキーを押しながら開いて、「コンテンツの有効化」を押してからいったん閉じて、それから使ってください。

「部品2」みたいなファイルです。
こちらも「カンタンに取り外し可能な」。
いったん(01)を閉じるのは、「ダイアログ」や「(01)が開いているがために出てしまうエラー」などを回避するためです。
　　
　　

動作の流れとしては、以下のような流れで動きます。

・(01)を開く→(02)を参照設定しているため、(01)といっしょに(02)も、
　　　　　　　自動的に道連れで（かつ、自動的に非表示で）開きます。

・(01)から、(02)の中に作った「ピボット生成のための各種設定用」のフォームを開き、
　　ピボットソースとなるaccdbやテーブル又はクエリの名前、その他、
　　の指定をします。

・(01)から、(02)のフォーム上に作ったコマンドボタンを押下。(03)を起動させます。

・(03)が非表示モードで開き、AutoExecマクロによって、(01)をいったん閉じます。
　　（ダイアログが表示されてしまう不都合の回避のため）

・(03)の、同じくAutoExecマクロによって、
　　(01)をソースにしたピボット自動生成のプログラムが自動実行されます。
　　そのプログラムの中で新規ブックとピボットが自動生成され、完了したら、
　　(01)がまた起動され、(03)は勝手に閉じられます。
　　
　　
基本的に、(02)と(03)のaccdbファイルの置き場所さえ固定しておけば、
『ピボットを自動生成したいaccdbに(02)のファイルを参照設定する』
ということのみで、
上記の流れでピボットの自動生成が可能となります。

まあ正直、「ちょっとめんどくさい」ことはめんどくさいですけど、
多少なりとも時短にはつながると思います。
　　
※補足
Callでの呼びだしについてですが・・・、逆にExcelが、なんで「アドインまで作ってもCallで呼び出せないアホ仕様のままなのか？20年も。」というのが、意味がわかりません。
もちろんExcelでも、参照設定すればたしか ” Call ” はできたかと思いますが、それにしたって「参照設定したファイルが表示されて」しまいます。
しかも、呼び出しモト（参照モト）のファイルを閉じても、参照先ファイルが残っていやがる！
消えない！閉じない！
なんだ？これ？みたいな・・・。
そんな最低な仕様を「なんで？」改善せずに「20年も放置のままなのか？」、理由がさっぱりわかりません。
はじめてExcelVBAをさわったとき、あまりの残念な仕様に愕然としました。
（残ったExcelファイルをどうやったら消せるか・・・、何らかのプログラウで実現できないことは無いのでしょうけど、あまりにバカらしいので、「自動で最小化かなんかしといて、最後に手動で全部消せばいいや」と思いました。）
　　
　　
　　
　　
　　
　　
　　
　　
　　
　　
　　
　　

MENU

関連記事

最近の投稿

カテゴリー

MENU

★Access2000VBA・Excel2000VBA独学～Access2019のクエリをソースに、COMオートメーションでExcel2019のファイルを自動生成し、ピボットも自動生成する方法～

関連記事

最近の投稿

カテゴリー

タグ