VBA(Access)

【Access VBA】Excel形式でデータを出力する(前編)

スポンサードリンク

AccessのデータをExcelファイルに出力したい、と日頃から感じている人もいるのではないでしょうか?

そこで、AccessのデータをExcelに出力するVBAプログラミングを解説していきます。

合計2回に渡って進めますが、前半の今回は、新規のExcelブックにAccessテーブルのデータを貼り付けていく方法です。

Accessには手動でExcelファイルを出力するエクスポート機能もありますが、動作が以下のように限定されます。

  • データの開始位置がA1セルのみ→開始位置を調整できない
  • 作成時に保存もされる→ゴミファイルが発生する原因になる

今回紹介する方法は、これらの問題を解消できます。
好きなセル位置にデータを貼り付けられて、そのまま閉じればゴミファイルも溜まらないという優れた機能なので、ぜひマスターしてください。

サンプルデータはこちらからダウンロードできます。

≫ Excel_Report_01.zip

スポンサードリンク

完成品の動作

サンプルデータベースを開き、フォーム「F00基本マスタM」をクリックします。

フォームを開く

大分類が選択させた状態で「Excel」ボタンをクリックします。

Excelボタンをクリック

数秒後にデータが貼り付けられたExcelファイルが表示されました。
Excelが表示されるまでの時間は、データ量に左右されます。

Excelファイルが作成される

大分類のマスタデータとExcelファイルの中身は同じデータです。

大分類のデータ

中分類も同じようにExcel作成しましたが、テーブルデータと同じ中身です。

中分類のデータ

ファイル名もBook1のままなので、閉じればどこにも保存されません。

保存されていないファイル

必要な参照設定

AccessからExcelを操作するためには、参照設定が必要です。

Microsoft Excel ○○ Object Library」に必ずチェックを入れておきましょう。
ここではバージョンが16.0となっていますが、Officeのバージョンによって数字が変わるので注意してください。

参照設定

Officeのバージョンが原因でエラーが発生した場合は、一度Excel Objectのチェックを外して入れ直せば使えるようになります。

他にもテーブルからデータを抜き出すのに、「ADO」や「DAO」を使ったレコードセットの操作も必要ですので、忘れずに有効にしておきましょう。
サンプルデータベースはすでに有効になっているので、設定不要です。

スポンサードリンク

プログラムコードの解説

コードは以下のとおりです。

Private Sub Excel_Click()

Dim DB_dtl As DAO.Database, RS_dtl As DAO.Recordset
Dim stSQL_dtl As String

Dim xlApp   As Object 'Excel.Application
Dim xlBook  As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.WorkSheet
Dim r As Object

Dim i As Long, j As Long

    'ここから出力用Excelの作成
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)

    stSQL_dtl = Me.F00基本マスタDS.Form.RecordSource

    Set DB_dtl = CurrentDb()
    Set RS_dtl = DB_dtl.OpenRecordset(stSQL_dtl)
    
    '見出し列名の挿入とセルの装飾
    For i = 0 To RS_dtl.Fields.Count - 1
        xlSheet.Range("A3").Offset(0, i).Value = RS_dtl.Fields(i).Name
    Next
    
    With xlSheet.Range("A3").Resize(1, RS_dtl.Fields.Count)
        .Interior.ColorIndex = 37
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
    End With
    
    'データの反映
    Set r = xlSheet.Range("A4")
        With r
            i = 0
            Do Until RS_dtl.EOF = True
                For j = 0 To RS_dtl.Fields.Count - 1
                    .Offset(i, j).Value = RS_dtl.Fields(j).Value
                    If j = 2 Then
                        .Offset(i, j).Style = "Comma [0]"
                    End If
                Next j
                RS_dtl.MoveNext
                i = i + 1
            Loop
        End With
    Set r = Nothing
    
    xlSheet.Range("A3").CurrentRegion.Select
    With xlApp.Selection
        For i = 7 To 12
            .Borders(i).LineStyle = 1
        Next i
    End With

    Set r = xlSheet.Columns("A:J")
        With r '幅の自動調整
            .EntireColumn.AutoFit
        End With
    Set r = Nothing
    
    Select Case Me.マスタ選択.Value
        Case 1
            xlSheet.Range("A1").Value = "大分類マスタ"
        Case 2
            xlSheet.Range("A1").Value = "中分類マスタ"
        Case 3
            xlSheet.Range("A1").Value = "小分類マスタ"
        Case 4
            xlSheet.Range("A1").Value = "発注先マスタ"
        Case 5
            xlSheet.Range("A1").Value = "発注者マスタ"
    End Select
    
    RS_dtl.Close
    Set RS_dtl = Nothing

    xlApp.Visible = True    '表示
    xlBook.Activate

    ' オブジェクトの参照を解放
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

End Sub

かなり長いコードですが、これから要点を順番に抜き出していきますね。

Excelの変数宣言と新規ブックを作成するのに必要なコードで、AccessからExcelを操作する時に共通で使われます

Dim xlApp   As Object 'Excel.Application
Dim xlBook  As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.WorkSheet

    'ここから出力用Excelの作成
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)

サブフォームに表示されているデータをそのまま使用するため、変数stSQL_dtlサブフォームのレコードソースを指定しています。
独自のSQL文を指定することも可能です。

    stSQL_dtl = Me.F00基本マスタDS.Form.RecordSource

    Set DB_dtl = CurrentDb()
    Set RS_dtl = DB_dtl.OpenRecordset(stSQL_dtl)

テーブルの見出しをExcelブックのセルに出力し、色を塗りつぶします。

    '見出し列名の挿入とセルの装飾
    For i = 0 To RS_dtl.Fields.Count - 1
        xlSheet.Range("A3").Offset(0, i).Value = RS_dtl.Fields(i).Name
    Next
    
    With xlSheet.Range("A3").Resize(1, RS_dtl.Fields.Count)
        .Interior.ColorIndex = 37
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
    End With

A4セルを先頭に、テーブルのデータをExcelブックのセルにそのまま出力します。
出力の基本は2重ループです。
2重ループで処理時間がかかる場合は、配列を使うことで高速化できます。

    'データの反映
    Set r = xlSheet.Range("A4")
        With r
            i = 0
            Do Until RS_dtl.EOF = True
                For j = 0 To RS_dtl.Fields.Count - 1
                    .Offset(i, j).Value = RS_dtl.Fields(j).Value
                    If j = 2 Then
                        .Offset(i, j).Style = "Comma [0]"
                    End If
                Next j
                RS_dtl.MoveNext
                i = i + 1
            Loop
        End With
    Set r = Nothing

罫線の設定列幅の自動調整を行います。

    xlSheet.Range("A3").CurrentRegion.Select
    With xlApp.Selection
        For i = 7 To 12
            .Borders(i).LineStyle = 1
        Next i
    End With

    Set r = xlSheet.Columns("A:J")
        With r '幅の自動調整
            .EntireColumn.AutoFit
        End With
    Set r = Nothing

Excelにデータを出力できたら、必ず表示を有効にしてExcelオブジェクトやレコードセットを閉じましょう。

    RS_dtl.Close
    Set RS_dtl = Nothing

    xlApp.Visible = True    '表示
    xlBook.Activate

    ' オブジェクトの参照を解放
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

Excelを出力するまでの工程が多く、コードも長いのでなかなか手が伸びないかもしれません。
しかし、本記事で紹介したコードをテンプレ化して必要な部分だけを修正していけば、どのテーブルやクエリでもExcelに出力できます。

まとめ

以上、AccessからExcelレポートを出力するVBA プログラミングについて解説しました。

前半として、テーブルやクエリのデータをそのまま出力しましたが、次回の後半は発注伝票を出力する方法を解説します。

スポンサードリンク

スポンサードリンク

-VBA(Access)