AccessVBAでExcelエクスポートを共通部品化：シート名・書式・列幅まで自動設定

AccessVBAでExcelエクスポート、書式まで整えたい。

AccessVBAでExcelエクスポート、書式まで整えたい。

AccessVBAを利用していると、テーブルやクエリの結果をExcelファイルとして出力したい場合が多くあります。

シチュエーション

一覧表の配布
社員一覧や在庫一覧をExcelで関係者に配布する処理
見出しに色を付けたい
列幅を整えて渡したい

月次の実績報告
集計クエリの結果をそのまま報告資料として提出するパターン
シート名を「7月実績」などにしたい
毎月同じレイアウトで出力したい

他システムへの連携ファイル作成
決められたレイアウトのExcelを定期的に作成するケースです。
抽出条件だけ変えて何種類も出力
ファイル名・シート名は規則で決まっている

Excelへの出力自体は、TransferSpreadsheetを使えば1行で可能です。

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
                              "T_社員", "C:\work\社員一覧.xlsx", True

しかしこの方法では見出しの書式や列幅までは設定できず、結局Excelを開いてから手作業で整えることになります。
そこで、シート名の指定・見出しの書式設定・列幅の自動調整まで一括で行う汎用プロシージャを紹介します。

Excelエクスポートを行うプロシージャサンプル

サンプルコードを紹介します。

'=========================================================
'  プロシージャ名：gf_EXPORT_EXCEL
'  機能　　：テーブル/クエリ/SQLの結果をExcelファイルに出力します。
'
'  【引数】
'    strSource     ：出力元（テーブル名・クエリ名・SQL文）
'    strFilePath   ：出力先Excelファイルのフルパス
'    [strSheetName]：シート名（省略時 "Sheet1"）
'                    ※31文字以内、\ / : * ? [ ] は使用不可
'
'  【戻り値】
'    True  … 正常終了
'    False … エラー発生
'
'  【処理概要】
'    ・Recordsetを開き、Excelを起動して新規ブックに出力
'    ・1行目に列名を出力し、太字・背景色・罫線を設定
'    ・列幅を自動調整し、見出し行を固定して保存
'
'  【使用例】
'    Call gf_EXPORT_EXCEL("T_社員", "C:\work\社員一覧.xlsx", "社員一覧")
'=========================================================
Public Function gf_EXPORT_EXCEL(strSource As String, _
                                strFilePath As String, _
                                Optional strSheetName As String = "Sheet1") As Boolean

    On Error GoTo err_EXPORT_EXCEL

    Dim l_db As DAO.Database      ' Database
    Dim l_rs As DAO.Recordset     ' 出力対象Recordset
    Dim l_xlApp As Object         ' Excel.Application
    Dim l_xlBook As Object        ' Workbook
    Dim l_xlSheet As Object       ' Worksheet
    Dim l_col As Long             ' 列カウンタ

    '=== Recordsetを開く（テーブル名・クエリ名・SQLいずれも可）===
    Set l_db = CurrentDb
    Set l_rs = l_db.OpenRecordset(strSource, dbOpenSnapshot)

    '=== Excelを起動（遅延バインディングなので参照設定は不要）===
    Set l_xlApp = CreateObject("Excel.Application")
    l_xlApp.Visible = False

    Set l_xlBook = l_xlApp.Workbooks.Add
    Set l_xlSheet = l_xlBook.Worksheets(1)

    '=== シート名を設定 ===
    l_xlSheet.Name = strSheetName

    '=== 1行目：列名を出力 ===
    For l_col = 0 To l_rs.Fields.Count - 1
        l_xlSheet.Cells(1, l_col + 1).Value = l_rs.Fields(l_col).Name
    Next l_col

    '=== 2行目以降：データを一括出力 ===
    l_xlSheet.Range("A2").CopyFromRecordset l_rs

    '=== 見出し行の書式設定（太字・背景色）===
    With l_xlSheet.Range(l_xlSheet.Cells(1, 1), l_xlSheet.Cells(1, l_rs.Fields.Count))
        .Font.Bold = True
        .Interior.Color = RGB(221, 235, 247)    ' 薄い青
    End With

    '=== データ範囲全体に罫線 ===
    l_xlSheet.Range("A1").CurrentRegion.Borders.LineStyle = 1    ' xlContinuous

    '=== 列幅の自動調整 ===
    l_xlSheet.Columns.AutoFit

    '=== 見出し行を固定 ===
    l_xlApp.Goto l_xlSheet.Range("A2"), True
    l_xlApp.ActiveWindow.FreezePanes = True

    '=== 保存（同名ファイルは上書き）===
    l_xlApp.DisplayAlerts = False
    l_xlBook.SaveAs strFilePath, 51    ' 51 … xlsx形式
    l_xlApp.DisplayAlerts = True

    '=== 後片付け ===
    l_xlBook.Close False
    l_xlApp.Quit

    Set l_xlSheet = Nothing
    Set l_xlBook = Nothing
    Set l_xlApp = Nothing

    l_rs.Close
    Set l_rs = Nothing

    gf_EXPORT_EXCEL = True

    Exit Function


err_EXPORT_EXCEL:

    '=== エラー処理 ===
    MsgBox "【gf_EXPORT_EXCEL】Excel出力中にエラー発生" & vbCrLf & _
           "番号：" & Err.Number & vbCrLf & _
           "内容：" & Err.Description, vbCritical

    '=== Excelのプロセスを残さないよう後片付け ===
    On Error Resume Next
    If Not l_xlBook Is Nothing Then l_xlBook.Close False
    If Not l_xlApp Is Nothing Then l_xlApp.Quit
    On Error GoTo 0

    gf_EXPORT_EXCEL = False

End Function

CopyFromRecordsetでデータを一括出力し、見出し行の書式・罫線・列幅・ウィンドウ枠の固定までまとめて行います。CreateObjectの遅延バインディングなので参照設定は不要です。

実行方法

テーブルやクエリをそのまま出力する場合には以下のように利用します。

    Call gf_EXPORT_EXCEL("T_社員", "C:\work\社員一覧.xlsx", "社員一覧")

引数に出力元（テーブル名・クエリ名）と出力先パス、シート名を渡すと出力が可能となっています。

SQLの結果を出力する場合は以下のように利用します。

    Dim strSql As String

    strSql = "SELECT 社員ID, 氏名, 部署 FROM T_社員 WHERE 在籍 = True"

    Call gf_EXPORT_EXCEL(strSql, "C:\work\在籍者一覧.xlsx", "在籍者")

動的に組み立てたSQLをそのまま渡せるので、条件付きの一覧出力にも利用できます。

出力されるExcelのイメージ

例として、以下のようなT_社員テーブルを出力してみます。

社員ID	氏名	部署	入社日	在籍
1001	山田太郎	営業部	2015/04/01	Yes
1002	佐藤花子	総務部	2018/10/01	Yes
1003	鈴木一郎	開発部	2020/04/01	Yes
1004	田中次郎	営業部	2021/07/01	No

以下のように呼び出すと、

    Call gf_EXPORT_EXCEL("T_社員", "C:\work\社員一覧.xlsx", "社員一覧")

このようなExcelファイルが作成されます。

AccessVBAで出力したExcelファイルの例（見出しの書式・罫線・列幅が自動設定された状態）

1行目の見出しは太字＋薄い青の背景になり、データ範囲には罫線が引かれ、列幅は文字数に合わせて自動調整されています。

見出し行が固定されているので、件数が多くなっても項目名を表示したままスクロールできます。シート名も引数で指定した「社員一覧」になっており、開いてそのまま配布できる状態です。

Yes/No型はTRUE / FALSE、数値や日付は右寄せと、Excel側の既定の表示形式がそのまま反映されます。

複数シートに分けて出力したい。

複数のテーブルやクエリを、1つのブックにシートを分けて出力する関数も書いてみました。

'=========================================================
'  プロシージャ名：gf_EXPORT_EXCEL_MULTI
'  機能　　：複数のテーブル/クエリ/SQLを1つのExcelブックに
'            シートを分けて出力します。
'
'  【引数】
'    arrSource    ：出力元の配列（テーブル名・クエリ名・SQL文）
'    strFilePath  ：出力先Excelファイルのフルパス
'    arrSheetName ：シート名の配列（arrSourceと同じ要素数）
'
'  【戻り値】
'    True  … 正常終了
'    False … エラー発生
'=========================================================
Public Function gf_EXPORT_EXCEL_MULTI(arrSource As Variant, _
                                      strFilePath As String, _
                                      arrSheetName As Variant) As Boolean

    On Error GoTo err_EXPORT_EXCEL_MULTI

    Dim l_db As DAO.Database      ' Database
    Dim l_rs As DAO.Recordset     ' 出力対象Recordset
    Dim l_xlApp As Object         ' Excel.Application
    Dim l_xlBook As Object        ' Workbook
    Dim l_xlSheet As Object       ' Worksheet
    Dim l_col As Long             ' 列カウンタ
    Dim l_lp As Long              ' ループカウンタ

    Set l_db = CurrentDb

    '=== Excelを起動 ===
    Set l_xlApp = CreateObject("Excel.Application")
    l_xlApp.Visible = False

    Set l_xlBook = l_xlApp.Workbooks.Add

    '=== 出力元ごとにシートを作成して出力 ===
    For l_lp = LBound(arrSource) To UBound(arrSource)

        Set l_rs = l_db.OpenRecordset(arrSource(l_lp), dbOpenSnapshot)

        '=== 1つ目は既存シート、2つ目以降は末尾に追加 ===
        If l_lp = LBound(arrSource) Then
            Set l_xlSheet = l_xlBook.Worksheets(1)
        Else
            Set l_xlSheet = l_xlBook.Worksheets.Add( _
                            , l_xlBook.Worksheets(l_xlBook.Worksheets.Count))
        End If

        l_xlSheet.Name = arrSheetName(l_lp)

        '=== 1行目：列名を出力 ===
        For l_col = 0 To l_rs.Fields.Count - 1
            l_xlSheet.Cells(1, l_col + 1).Value = l_rs.Fields(l_col).Name
        Next l_col

        '=== 2行目以降：データを一括出力 ===
        l_xlSheet.Range("A2").CopyFromRecordset l_rs

        '=== 見出し行の書式設定・罫線・列幅 ===
        With l_xlSheet.Range(l_xlSheet.Cells(1, 1), l_xlSheet.Cells(1, l_rs.Fields.Count))
            .Font.Bold = True
            .Interior.Color = RGB(221, 235, 247)
        End With

        l_xlSheet.Range("A1").CurrentRegion.Borders.LineStyle = 1
        l_xlSheet.Columns.AutoFit

        l_rs.Close

    Next l_lp

    '=== 先頭シートを選択して保存 ===
    l_xlBook.Worksheets(1).Activate

    l_xlApp.DisplayAlerts = False
    l_xlBook.SaveAs strFilePath, 51    ' 51 … xlsx形式
    l_xlApp.DisplayAlerts = True

    l_xlBook.Close False
    l_xlApp.Quit

    Set l_xlSheet = Nothing
    Set l_xlBook = Nothing
    Set l_xlApp = Nothing
    Set l_rs = Nothing

    gf_EXPORT_EXCEL_MULTI = True

    Exit Function


err_EXPORT_EXCEL_MULTI:

    '=== エラー処理 ===
    MsgBox "【gf_EXPORT_EXCEL_MULTI】Excel出力中にエラー発生" & vbCrLf & _
           "番号：" & Err.Number & vbCrLf & _
           "内容：" & Err.Description, vbCritical

    '=== Excelのプロセスを残さないよう後片付け ===
    On Error Resume Next
    If Not l_xlBook Is Nothing Then l_xlBook.Close False
    If Not l_xlApp Is Nothing Then l_xlApp.Quit
    On Error GoTo 0

    gf_EXPORT_EXCEL_MULTI = False

End Function

シートごとに見出しの書式設定と列幅調整を行うので、出力レイアウトが統一できます。

実行方法はこのような形です。

Private Sub sample_EXPORT_EXCEL_MULTI()

    Dim arrSource(1) As String    ' 出力元
    Dim arrSheet(1) As String     ' シート名

    arrSource(0) = "T_社員"
    arrSheet(0) = "社員一覧"

    arrSource(1) = "SELECT * FROM T_部署 ORDER BY 部署コード"
    arrSheet(1) = "部署一覧"

    If gf_EXPORT_EXCEL_MULTI(arrSource, "C:\work\マスタ一覧.xlsx", arrSheet) Then
        MsgBox "出力完了"
    Else
        MsgBox "エラー"
    End If

End Sub

出力元とシート名をそれぞれ配列で渡すと処理が可能となっています。

実行すると、1つのブックに「社員一覧」「部署一覧」の2シートが作成されます。