#689
個別のデータのまったく入力されていない、それ以外の枠組みだけのExcelのワークシートをあらかじめテンプレートとして作成しておき、それにAccessからデータ部分だけを流し込み、特定のファイル名で保存するという処理の例を紹介します。
まず、ここでは例として次のようなワークシートをテンプレートとして作っておきます。
- ここでは分かりやすくするため、あえてAccessからデータを流し込むセルの背景色をオレンジに設定してあります。
- 各セルの書式設定（表示形式や文字配置、フォント、罫線等）もあらかじめ設定しておきます。
- 計算式のあるセル（税抜合計や消費税など）もあらかじめ設定しておきます。
- ファイル名は「受注伝票テンプレート.xlsx」として、今回の例では定数で指定した場所に保存されているものとします。
次に、Access側の処理として、Excel側で必要となるデータがすべて揃ったテーブルやクエリを用意しておきます。
ここでは次のようなクエリを作り、ある１つの受注IDだけを抽出条件に指定し、かつテーブルを結合することでそれに関連した顧客や商品明細などのデータが得られるようにしました。なお、その都度異なる特定の受注IDだけ取り出す処理についてはいろいろな方法がありますが、ここでは割愛し、クエリに固定で組み込まれているものとします。
このとき、Accessのクエリのフィールド名とExcelのワークシートのセル位置との関係は次のようになります。
| クエリのフィールド名 | シートの行番号 | シートの列番号 |
|---|---|---|
| 受注ID | 4 | 2 |
| 得意先ID | 5 | 2 |
| 得意先郵便番号と住所 | 6 | 2 |
| 得意先名 | 7 | 2 |
| 商品コード | 10〜 | 1 |
| 商品名 | 10〜 | 2 |
| 数量 | 10〜 | 5 |
| 単価 | 10〜 | 6 |
| 金額 | 10〜 | 7 |
| （日付） | 4 | 7 |
そして、一連の処理を行うプログラムの流れとしては次のようなものとなります。
- データ元であるクエリ「qsel受注伝票」を開いて、そのレコードセットを取得します。
- AccessからExcelを操作するため、Excelオブジェクトを生成します。
- Excelへ命令を送り、「受注伝票テンプレート.xlsx」を開いて、シート「Sheet1」を新規ブックにコピーしたあと、閉じます。以降はコピーされた方のブックのワークシートに対して処理することになります。
- 受注IDや得意先の会社名、住所等は全レコード同じなので、その時点、つまり先頭レコードから各値を取得して、Excelのワークシートの当該セルに代入します。
なおここでは、必ず１レコードはデータが存在しているという前提としています（空ならエラーとなりますがその回避処理は割愛しています）。
- 商品明細はその数だけレコードがありますので、ループで回して、１行ごとにその値をExcelのワークシートの各行の当該セルに代入します。
ここでは変数intRowが、ループが進むごとにワークシート上の出力先行番号を＋１していくカウンタとなっています。
- データを流し込んだワークシートのブックを「受注伝票_〇〇〇〇〇.xlsx」という名前で保存します。〇〇〇〇〇の部分には５桁のゼロ埋めで受注IDを設定します。また保存先フォルダは、この例では定数で宣言しておくものとします。
- この例では、見えないところで新規ブックの生成から保存までを行っています。Excel自体を可視化することなく処理を完結させていますので、最後に、起動したExcelをAccess側から終了させます。
Public Sub ExcelTemplateSample()
Dim dbs As Database
Dim rst As Recordset
Dim xls As Object
Dim intRow As Integer
Dim lngOrderID As Long
Dim strSaveBookPath As String
'テンプレートの保存先フォルダ
Const cstrTemplateDir As String = "C:\テスト\"
'テンプレートのファイル名
Const cstrTemplateBook As String = "受注伝票テンプレート.xlsx"
'データが代入されたファイルの保存先フォルダ
Const cstrSaveBookDir As String = "C:\テスト\"
'データ元のクエリを開く
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("qsel受注伝票")
'Excelオブジェクトを生成
Set xls = CreateObject("Excel.Application")
With xls
'画面の再描画を抑止
.ScreenUpdating = False
'テンプレートファイルを開く
.Workbooks.Open cstrTemplateDir & cstrTemplateBook
'ワークシートをコピー
.Workbooks(cstrTemplateBook).Worksheets("Sheet1").Copy
'テンプレートファイルを閉じる
.Workbooks(cstrTemplateBook).Close
'１レコード目から受注IDと得意先情報を代入
lngOrderID = rst!受注ID
.Cells(4, 2).Value = lngOrderID
.Cells(5, 2).Value = rst!得意先ID
.Cells(6, 2).Value = "〒" & rst!郵便番号 & " " & rst!住所
.Cells(7, 2).Value = rst!会社名
.Cells(4, 7).Value = Date
'商品明細の全レコードをループで各セルに代入
intRow = 10
Do Until rst.EOF
.Cells(intRow, 1).Value = rst!商品コード
.Cells(intRow, 2).Value = rst!商品名
.Cells(intRow, 5).Value = rst!数量
.Cells(intRow, 6).Value = rst!販売単価
.Cells(intRow, 7).Value = rst!金額
intRow = intRow + 1
rst.MoveNext
Loop
rst.Close
'保存するファイル名のフルパスを組み立て
strSaveBookPath = cstrSaveBookDir & "受注伝票_" & Format$(lngOrderID, "00000") & ".xlsx"
'同名ファイルを強制削除
On Error Resume Next
Kill strSaveBookPath
On Error GoTo 0
'データを代入したブックを保存
.ActiveWorkBook.SaveAs strSaveBookPath
'画面の再描画を元に戻す
.ScreenUpdating = True
'Excelを終了
.Quit
End With
Set xls = Nothing
End Sub
補足
- ここでは、すでに出力先の同名ファイルがある場合、強制的に削除するものとしています。ファイルがない場合は「Kill」ステートメントでエラーが発生しますので、「On Error Resume Next」でエラーを無視し、直後の「On Error GoTo 0」で以降のエラーは無視しないように戻しています。なお、同名ファイルがある場合に「Kill」なしで「SaveAs」を実行した場合には、Excelオブジェクト側で既存ファイルを置き換えるかどうかのメッセージボックスが表示されます。そこで[いいえ]や[キャンセル]が選択された場合にはAccess側でエラーが発生しますので、別途それをトラップするコードが必要となります。
- 「.xltx」などではなく通常の「.xlsx」形式のファイルであれば、結果は同じですが、別の処理手順として『テンプレートファイルをまずは所定のファイル名でコピーし、コピーされた方のブックを開き、そこにデータを流して保存する』という手順もあります。
実行例：
