Microsoft Access 掲示板
見積書～3つのクエリのIDでフィルターを掛けて、エクセルのブックの3シートへそれぞれエクスポートをする / 6
■続きです
.ScreenUpdating = False
.Workbooks.Open cstrTemplateDir & cstrTemplateBook
.Workbooks(cstrTemplateBook).WorkSheets("Sheet2").Copy
.DisplayAlerts = False
.Workbooks(cstrTemplateBook).Save
.Workbooks(cstrTemplateBook).Close
.DisplayAlerts = True
.Cells(2, 1).CopyFromRecordset rst2
Set qdf3 = dbs.QueryDefs("Q_明細3_R")
With qdf3
.Parameters("見積りNO") = Forms!F見積!見積りNo
Set rst3 = .OpenRecordset
End With
Set xls = CreateObject("Excel.Application")
With xls
.ScreenUpdating = False
.Workbooks.Open cstrTemplateDir & cstrTemplateBook
.Workbooks(cstrTemplateBook).WorkSheets("Sheet3").Copy
.DisplayAlerts = False
.Workbooks(cstrTemplateBook).Save
.Workbooks(cstrTemplateBook).Close
.DisplayAlerts = True
.Cells(2, 1).CopyFromRecordset rst3
rst1.Close
rst2.Close
rst3.Close
'保存するファイル名のフルパスを組み立て
strSaveBookPath = cstrSaveBookDir & "見積書" & Format$(Forms!F_見積!物件名) & ".xlsx"
On Error Resume Next '同名ファイルを強制削除
Kill strSaveBookPath
On Error GoTo 0
.ScreenUpdating = True '画面の再描画を元に戻す
.ActiveWorkbook.SaveAs strSaveBookPath 'データを代入したブックを保存
MsgBox "データを保存しました"
.Quit 'Excelを終了
End With
Set xls = Nothing
End With
End With
End Sub