Microsoft Access 掲示板

■続きです

  .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