アクセスVBAでの出力設定について

質問

初めての質問投稿となります。
アクセステーブルデータを、フィールドキー毎にエクセルテンプレートへ出力しようと試みています。
様々なサイトを参考に下記の対応は作成してみたのですが、組み合わせ方が上手く理解できずに行き詰っております。

①テーブルのレコードをフィールドキー毎に
②エクセルのテンプレート(B3セルから)へレコード出力し
③シート名・ファイル名にフィールドキーをつけて保存
テーブル名：報告リスト　(ブロック/支店名/社員コード/etc...)
フィールドキー：ブロック

クエリにてフィールドキー毎のデータを作成し、都度エクセルへコピペする作業工数を減らすべくご教示いただけますと幸いです。

回答No.3

piroin654 · ベストアンサー

こちらの解釈でコードを組み立ててみました。

たとえば、「報告リスト」が以下のような
テーブルとします。IDは便宜上補充した
フィールドです。今のところデータの
取り出しに必要なものではないので、
以降のコードの中では用いていません。

ID----ブロック----支店名----社員コード
1-------東京----池袋支店--------123
2-------埼玉----川口支店--------211
3-------埼玉----所沢支店--------221
4-------群馬----高崎支店--------311
5-------千葉----松戸支店--------412
6-------東京----新宿支店--------111
7-------千葉----野田支店--------413
8-------群馬---伊勢崎支店-------312

ブロックごとのデータをExcelの雛型ファイルに
送り出し、データを受けた雛型のファイルを
ブロック別のファイル名と、データのあるシート
をブロック名の入ったシート名にして
別ファイルとして保存する、ということでいいですか。

コードの内容は、
（１）　テーブルの「ブロック名」の名寄せをして、
　　　　「ブロック」のテーブルをメモリ上に
　　　　作成。

（２）　（１）のデータを元に「報告リスト」に
　　　　ブロック毎にフィルタをかけ、ブロック
　　　　別のデータを取り出す。このとき、
　　　　コード上ではSQLで必要なフィールドだけに
　　　　焦点を合わせたデータを対象としています。
　　　　この場合は「ID」のフィールドを除外
　　　　しています。

（３）　（２）で取り出したデータをExcelの雛型
　　　　ファイルに送り出し、所定の位置に
　　　　貼り付ける。

（４）　雛型ファイルをそれぞれのブロック名で
　　　　保存し、そのときシート名もブロック名に
　　　　し、同じフォルダに保存。

（５）　順次、それぞれのブロックについても
　　　　同様にファイルを保存していく。

と、　このような感じです。以下がそのコードです。

Sub test()
　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset

　　Dim strPath As String
　　Dim strSQL1 As String
　　Dim strSQL2 As String
　　Dim qdf1 As DAO.QueryDef
　　Dim strKey As String

　　Dim objExcel As Object
　　Dim wkb As Object
　　Dim strFileName As String
　　Dim objSheetName As Object

　　strSQL1 = "SELECT 報告リスト.ブロック FROM 報告リスト GROUP BY 報告リスト.ブロック;"

　　strSQL2 = "SELECT 報告リスト.ブロック, 報告リスト.支店名, 報告リスト.社員コード " & _
　　　　　　　"FROM 報告リスト;"

　　strPath = CurrentProject.Path
　　'Set objExcel = CreateObject("Excel.Application")
　　Set objExcel = GetObject("", "Excel.Application")
　　Set wkb = objExcel.Workbooks.Open(Filename:=strPath & "\報告用雛型.xls")
　　Set objSheetName = wkb.Worksheets("Sheet1")

　　Set db = CurrentDb
　　Set qdf1 = db.CreateQueryDef("", strSQL1)
　　 'Set rs1 = db.OpenRecordset("Qブロック")
　　Set rs1 = qdf1.OpenRecordset()

　　rs1.MoveFirst
　　Do Until rs1.EOF
　　　　strKey = rs1!ブロック

　　　　Dim qdf2 As DAO.QueryDef
　　　　Set qdf2 = db.CreateQueryDef("", strSQL2)
　　　　Set rs2 = qdf2.OpenRecordset()
　　　　rs2.Filter = "ブロック = '" & strKey & "'"
　　　　Set rs2 = rs2.OpenRecordset()

　　　　If rs2.RecordCount > 0 Then
　　　　　　With objSheetName
　　　　　　　　.Range("B3").CopyFromRecordset rs2
　　　　　　　　.Name = strKey
　　　　　　End With
　　　　End If
　　　　strFileName = strPath & "\" & "" & strKey & "" & "報告書" & ".xls"
　　　　objExcel.DisplayAlerts = False
　　　　wkb.SaveAs strFileName
　　　　objExcel.DisplayAlerts = True

　　　　rs2.Close: Set rs2 = Nothing
　　　　qdf2.Close: Set qdf2 = Nothing

　　rs1.MoveNext
　　If rs1.EOF Then
　　　　wkb.Close
　　End If
　　Loop
　　　　Set objSheetName = Nothing
　　　　Set wkb = Nothing
　　　　objExcel.Quit
　　　　Set objExcel = Nothing

　　　　qdf1.Close: Set qdf1 = Nothing
　　　　rs1.Close: Set rs1 = Nothing
　　　　db.Close: Set db = Nothing
End Sub

こうした処理は、どこかでタスクの残存が生じて
一部のファイルが読み取り専用になったりして
あたふたするんですが、やはりタスクの残存が
生じてあたふたしましたが、タスクの強制終了の
コードを走らせることは何とか回避できたようです。
ただし、こちらの環境での話で、もしかしたら
別の環境ではそういったことが生じるかも
しれません。

なお、データをSQL文のクエリで抽出していますが、
これは必要に応じて、クエリを作成してそれを
テーブルにしてもいいですし、フィールド数が
多ければそのほうが運用するうえで楽かも
しれません。そのときはコードの変更で
わからないことがあれば補足などを
してください。

お礼

おはようございます。質問に目を留めて下さり感謝致します。
回答内容のご認識の通りとなります。
テーブル全レコードを雛形の所定セルへ全件出力は叶ったので、for～nextやDo～loopを組み合わせてチャレンジしていたのですがなかなか。。。
早速動作確認させていただきます。

補足

度々の補足失礼致します。
出力データの確認をしておりましたところ、データ量(行数)の多いブロックの次のブロック以降に不具合が見つかりました。
[例]
東京ブロック・・20行
埼玉ブロック・・50行
群馬ブロック・・30行➡30行まで群馬、31～50行まで埼玉のデータ
神奈川ブロック・20行➡20行まで神奈川、21～30行群馬、31～50行埼玉
雛形シートをcopyなど対応しておりますが解決に至っておりません。解決方法などご教示いただけますでしょうか。

回答No.6

chayamati

piroin654様
　あなたの予測が的中したようですね
　〈ブロック〉が何を意味するのか理解できませんでしたが
　ご回答中横から入り、失礼します。

koji_hg様回答に入ります
＞都度エクセルへコピペする作業工数を減らす　
★添付図はT_報告リストをレコードソースとした選択クエリです
・ブロックと支店名に並べ替えを設定します
・オートナンバー型の主キーのIDは必要ありません
・〈F_報告リスト〉を開いたときに
　1.データのエキスポート
　2.エクセルファイルを開く
　3.〈F_報告リスト〉閉じる
　この処理のコードです
--------------------------------------------------------------
Private Sub Form_Load()
Dim エクセル名 As String
エクセル名 = "C:\倉庫\報告用雛型.xlsx"
'エクセルへ転送
DoCmd.TransferSpreadsheet acExport, , "Q_報告リスト", エクセル名, True, "報告リスト"
'エクセルファイルを開く
Call Shell("Excel.exe " & エクセル名, vbMaximizedFocus)
'フォームを閉じる
DoCmd.Close
End Sub
---------------------------------------------
エキスポートのセル位置はA1からで、別のsheetに式で設定します
エクセル名 = "C:\倉庫\報告用雛型.xlsx"
拡張子が.xltの雛形ファイルの保存場所が分かりません

回答No.5

piroin654

このようなエラーは実際のコードを見ないと
わからないのですが。
コード中のどこかで構造的な変更あるいは
書き加えはありますか。

たとえば、以下のIf文はそのまま存在していますか。
　　rs1.MoveNext
　　If rs1.EOF Then
　　　　wkb.Close
　　End If

＞しかしながら、最後の　objExcel.Quit 部で、
＞「オブジェクト変数またはwith ブロック変数が
＞設定されていません。」エラーとなり、
＞雛形Excelが読取のままとなってしまいます。

これはたぶん雛型ファイルを閉じるときに何らかの
操作を加えたりした場合に起こります。
あるいは何らかの理由でファイルが開いたまま
なっている場合です。

あるいは、
　　　　objExcel.Quit
　　　　Set objExcel = Nothing
の上下が入れ替わっているとか。

コードの最後のあたりで、

　　End If
　　Loop
　　　　On Error Resume Next
　　　　Set objSheetName = Nothing
　　　　wkb.Close
　　　　Set wkb = Nothing
　　　　objExcel.Quit
　　　　Set objExcel = Nothing

　　　　qdf1.Close: Set qdf1 = Nothing
　　　　rs1.Close: Set rs1 = Nothing
　　　　db.Close: Set db = Nothing

のように、
　　　　On Error Resume Next
と
　　　　wkb.Close

を加えてみてください。
また、
　　Set objExcel = GetObject("", "Excel.Application")
を
　　Set objExcel = CreateObject("Excel.Application")

に切り替えてみてみてください、

それでもExcelのタスクが残るようであれば
強制的にExcelを終了させるコードを走らせる
ことにします。

一度は

https://www.google.co.jp/search?q=ms+access+%E3%82%AA%E3%83%96%E3%82%B8%E3%82%A7%E3%82%AF%E3%83%88%E5%A4%89%E6%95%B0%E3%81%BE%E3%81%9F%E3%81%AFwith+%E3%83%96%E3%83%AD%E3%83%83%E3%82%AF%E5%A4%89%E6%95%B0%E3%81%8C%E8%A8%AD%E5%AE%9A%E3%81%95%E3%82%8C%E3%81%A6%E3%81%84%E3%81%BE%E3%81%9B%E3%82%93&ei=AAB_Y_DaF7O32roPiNyx4AY

で、確認してみてください。

お礼

回答ありがとうございます。
「On Error Resume Next」と「wkb.Close」の追加でエラー&Excelタスク終了確認致しました！(10回実施)

回答No.4

piroin654

投稿した後で気が付いたのですが、コード中の

SQL文の乱れ
　　コメントアウトしたままのコード
　　Excelファイルの拡張子が　xls　になっている

などがあります。そのあたりは確認しながら試してみて
ください。

なお、コメントアウトしたままの、

'Set rs1 = db.OpenRecordset("Qブロック")

は、名寄せをするために作成したクエリを
レコードセットとする一文です。投稿したコードでは
使用していません。

お礼

お世話になっています。下記現象の対応は次ブロック書き込え前にobjsheetname内の書込み行以降のデータをクリアする一文で対応致しました。(.Borders.LineStyle = xlLineStyleNoneが上手く機能せず、一番多いデータの範囲まで罫線が出てしまうのですが、ひとまず、都度担当者に削除してもらうこととします。)
<出力ファイル内のデータ内容>********************
1ファイル目/東京・・20データ(行)
2ファイル目/埼玉・・50データ(行)
3ファイル目/群馬・・30行データ(行)➡30行まで群馬、31～50行まで埼玉のデータ
4ファイル目/神奈川・・20行データ(行)➡20行まで神奈川、21～30行群馬、31～50行埼玉
雛形シートcopyなど対応しておりますが解決に至っておりません。解決方法などご教示いただけますでしょうか。
******************************************************

こちらのサイトへの投稿は初めてで、使い勝手が分からず、初期段階回答へのお礼となりますこと、ご容赦願います。
データ増大やキーとなるフィールド増となっても、こちらのVBAを使いボタン一つで作業が完結します。
他案件時にも応用させていただきます。本当にありがとうございました。

補足

動作確認し、思い通りのリストが出力できました！
現在、データ範囲への罫線設定で苦戦中ですが、出力先の指定(変更)とセル幅の自動調整はできました。

しかしながら、最後の　objExcel.Quit 部で、「オブジェクト変数またはwith ブロック変数が設定されていません。」エラーとなり、雛形Excelが読取のままとなってしまいます。

こちらの回避につき補足いただけますと幸いです。
よろしくお願い致します。

回答No.2

chayamati

的外れならゴメン
①テーブルのレコードをフィールドキー毎に
例えば〈特定の日付と支店名〉
②エクセルのテンプレート(B3セルから)へレコード出力し
　デザインされた伝票の項目と解釈します
③シート名・ファイル名にフィールドキーをつけて保存
　Accessからエキスポートすると新規にSheetが生成されますがセル内の式も記述せねば
　ならないため　〈シート名・ファイル名〉を変更する事は自動では不可能
テーブル名：報告リスト　(ブロック/支店名/社員コード/etc...)
　〈ブロック〉とはテーブル内の１つのレコードと解釈しました。
フィールドキー：ブロック
　〈フィールドキー〉とは日付、商品等の組み合わせの抽出keyと解釈しました
-----------------------------------------------------------------------
〈テンプレート〉
　Accessの価格が高額だったころ、業務はExcelでやっていました
　Excelの式は行、列、sheetのどのアドレスでも対象と出来るので良いが、
　表示されるので、式のあるセルも、実数のセルも表示されるので、式のあるセルの値が
　期待と違うとき、期待値を入力してしまい、せっかくの式が潰れてしまい。
　拡張子が〈*.xltx〉形式のテンプレートを開いて入力の必要なセルへ入力して保存すると
　新規ファイル.xlsとなる。
★Excelからのエキスポートを試みましたがうまくいきません
因みにコロナ感染者数の新聞情報をAccessに入力して、グラフ化のためExcelへ
　エキスポートしています
添付図をご覧下さい
A,B,C列がエキスポートされた項目で保健所毎に縦にンランでいます。
D,E,F列がグラフ作成用に式で配置しました
★Accessでは項目毎に入力、数値、文字、入力ロック、スキップ、コンボの定義できるので
　入力のスピードと精度が上がります

お礼

回答ありがとうございました。
やりたいことはとてもシンプルで、テーブルのレコードをブロック別に雛形のExcelにレコード出力するというものです。
回答いただきました内容は、今後のAccess活用法として参考にさせていただきます。
質問に目を留めていただき大変嬉しく、感謝しております。ありがとうございました。

回答No.1

chayamati

自分ならExcelでAccessをインポートするより
Accessでクエリを作成し、Excelへエキスポートします。
添付図参照
---------------------------------------
補足願います
①テーブルのレコードをフィールドキー毎に
　〈フィールドキー〉どのようなものですか
②エクセルのテンプレート(B3セルから)へレコード出力し
　〈テンプレート〉とは雛形のエクセルファイル　
　〈*.xltx〉の事ですよね
　　通常は〈*.xlsx〉、〈*.xlms〉で運用しますが
　　敢えて〈テンプレート〉にした狙いは何ですか
〈レコード出力〉B3セルの値を含むテーブルのレコードを対象と
　することですか
③シート名・ファイル名にフィールドキーをつけて保存
　テーブル名：報告リスト　(ブロック/支店名/社員コード/etc...)
　フィールドキー：ブロック
　このSheetの数はおおよそ何件ぐらいですか

補足

回答ありがとうございました。
何点か補足させていただきます。
Accessフォーム上の出力ボタン押下により、所定のフォルダ内に、ブロック毎のリストを出力しようとしています。
こちらのリストはクライアントへの納品物となります。
①フィールドキーとは、リスト内の1項目(ブロック)を指します。
②テンプレートとは.xlsxで作成した雛形です。
③現在シート数(ブロック数)は12です。

いずれも紛らわしい表示で申し訳ありませんでした。よろしくお願い致します。