フォームのレコードソースをExcelで出力する。

「Accessのフォームから、データをかんたんにExcelに出力する方法」～VBAで関数にしちゃいましょ♪～ |

AccessからVBAでEXCELへ帳票出力する｜アズビーパートナーズ

参考にさせていただきました。

'Excelにデータを出力
Function ExcelData(frm As Form)
On Error GoTo Err_cmdExcel_Click
 'DAOで抽出結果のクローンを作成
Dim xls As Object 'Excel.Applicationを代入するオブジェクト変数
Dim wkb As Object 'Excel.Wookbookを代入するオブジェクト変数
Dim rst As DAO.Recordset '現在のレコードセットを入れる変数
Dim idx As Long  'フィールド数変数
Set rst = Nothing 'データリストの初期化
Set rst = frm.RecordsetClone  'フォームのレコードセットのクローンを代入
 'レコードが存在しない場合、処理を中止
If rst.BOF = True And rst.EOF = True Then
MsgBox "出力出来るデータがありません。", vbOKOnly + vbExclamation, "出力不可"
 'レコードセットを閉じる
rst.Close: Set rst = Nothing
Exit Function
End If
 'レコードが存在する場合、Excelに出力
 'レコードセットの最初のデータにカーソルを移動
rst.MoveFirst
 'Excelファイルを内部的に作成
Set xls = CreateObject("Excel.Application")
 '作成されたExcelファイルにワークブックを追加
Set wkb = xls.Workbooks.Add()
 'Worksheets(1).Name = "売上データ"
wkb.Worksheets(1).Name = "マスタ"
 '追加されたワークブックに、レコードセットのデータをコピー
With wkb.Worksheets(1)
For idx = 1 To rst.Fields.Count
.Cells(1, idx).Value = rst.Fields(idx - 1).Name
Next
.Range("A2").CopyFromRecordset Data:=rst
.columns(rst.Fields.Count).Delete '最終列の削除をする場合はこの行で削除する。
End With
 'ﾌｧｲﾙ名作成
Dim strFileName     As String
strFileName = "sample3" & "_" & Format(Date, "yyyymmdd") & ".xlsx"
 '完了したら保存
xls.ActiveWorkBook.SaveAs FileName:=strFileName
 'レコードセットを閉じる
rst.Close: Set rst = Nothing
 'Excelデータを表示
'    xls.Visible = True
'    xls.UserControl = True
xls.Visible = False
xls.UserControl = False
 'メモリに展開されたExcel用オブジェクト変数を開放
Set wkb = Nothing
Set xls = Nothing
Exit_cmdExcel_Click:
Exit Function
Err_cmdExcel_Click:
 'エラーの場合、エラーNOと内容を表示
'    MsgBox Err.Number & Err.Description
MsgBox "エラーのため、Excelへ出力できません。" & vbCrLf & "一旦フォームを閉じ、再度トライしてください。", _
vbOKOnly + vbCritical, "Excel出力不可！"
Resume Exit_cmdExcel_Click
End Function

呼び出し側

Private Sub cmdExcel_Click()
 'Meは、このフォームという意味
Call ExcelData(Me)
 '（forms!Form商品一覧というように、ここにフォーム名を指定してもOK!）
 'Call ExcelData(Forms!商品一覧)
End Sub