将 (4) Forms/Subforms 查询和 table 数据导出到 Excel

Question

我找到了多篇关于如何将 (1) Access form/subform 输出到 excel 的文章，但我找不到任何可以向我解释如何将 4 个子表单输出到同一个工作簿的文章。

我想将以下子表单导出到一个 excel 工作簿：

[tmp_Formula]

[qry_BatchCoating 子窗体]

[qry_ContinuousCoating 子窗体]

[qry_ENCAP 子表单]

理想情况下，我想将它们导出到静态位置的 (1) sheet。这意味着我想输出一个从 A1 开始的子表单，下一个从 A26 开始，下一个从 G26 开始，最后一个子表单从 N26 开始。如果这不可能，将它们导出到单个工作簿仍然是我的目标。

如有任何帮助，我们将不胜感激。谢谢！

Answer 1

所以我无法在网上找到任何适合我提取 4 个数据集并将它们发布到 Excel 中的工作表的需要的参考资料。 dbMitch 为我指明了正确的方向，但是由于我的数据库格式是 accdb 而不是 mdb，我无法使该代码工作。

所以我使用来自 Microsoft 的 vba 参考并进行了大量试验和错误来写这篇文章。无论如何，这是有效的，我希望未来的读者能看到它。它说的那一点，"For Each fld In rs..." 这就是你想要数据集在电子表格上的位置。希望这对您有所帮助！

Private Sub Command25_Click()

Dim rs1, rs2, rs3, rs4 As DAO.Recordset
Dim cnt As Integer

Dim appExcel As Excel.Application
Dim wbk As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range

Set appExcel = Excel.Application
Set wbk = appExcel.Workbooks.Add
Set wks = wbk.Worksheets(1)
Set rng = wks.Range("A2")

appExcel.Visible = False

cnt = 1

Set rs1 = CurrentDb.OpenRecordset("SELECT tmp_Formula.RawMaterial, tmp_Formula.MiscInfo, tmp_Formula.Potency, " _
  & "tmp_Formula.PUoM, tmp_Formula.Claim, tmp_Formula.CUoM, tmp_Formula.Overage, " _
  & "tmp_Formula.Input, tmp_Formula.InputWeight, tmp_Formula.DV, tmp_Formula.Cost, " _
  & "tmp_Formula.CostUoM, tmp_Formula.BulkCost, tmp_Formula.BCWeight, " _
  & "IIf([Quantity]>=15,Format([Quantity],'0.0'),Format([Quantity],'0.000')) AS Qty, tmp_Formula.UoM " _
  & "FROM tmp_Formula;")

    For Each fld In rs1.Fields
        wks.Cells(1, cnt).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs1, 4000, 26)

Set rng = wks.Range("T3")

Set rs2 = CurrentDb.OpenRecordset("SELECT tbl_BatchCoatingIngredients.RawMaterial, tbl_BatchCoatingIngredients.Solution, " _
  & "tbl_BatchCoatingIngredients.Color, tbl_BatchCoatingIngredients.Quantity, tbl_BatchCoatingIngredients.UoM " _
  & "FROM tbl_BatchCoatingIngredients " _
  & "WHERE ((tbl_BatchCoatingIngredients.BP)='" & [Forms]![frm_Formulation]![BP] & "') " _
  & "AND ((tbl_BatchCoatingIngredients.Item)='" & [Forms]![frm_Formulation]![Item] & "') " _
  & "AND ((tbl_BatchCoatingIngredients.BillType)='" & [Forms]![frm_Formulation]![BILL TYPE] & "') " _
  & "AND ((tbl_BatchCoatingIngredients.Old)=No);")

  wks.Cells(1, 20).Value = "Batch Coating"

    For Each fld In rs2.Fields
        wks.Cells(2, cnt + 3).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs2, 4000, 26)

Set rng = wks.Range("T17")

Set rs3 = CurrentDb.OpenRecordset("SELECT tbl_ContinuousCoatingIngredients.RawMaterial, tbl_ContinuousCoatingIngredients.Solution, " _
  & "tbl_ContinuousCoatingIngredients.Color, tbl_ContinuousCoatingIngredients.Quantity, tbl_ContinuousCoatingIngredients.UoM " _
  & "FROM tbl_ContinuousCoatingIngredients " _
  & "WHERE (((tbl_ContinuousCoatingIngredients.BP)='" & [Forms]![frm_Formulation]![BP] & "') " _
  & "AND ((tbl_ContinuousCoatingIngredients.Item)='" & [Forms]![frm_Formulation]![Item] & "') " _
  & "AND ((tbl_ContinuousCoatingIngredients.BillType)='" & [Forms]![frm_Formulation]![BILL TYPE] & "') " _
  & "AND ((tbl_ContinuousCoatingIngredients.Old)=No));")

  wks.Cells(15, 20).Value = "Continuous Coating"

    For Each fld In rs3.Fields
        wks.Cells(16, cnt - 2).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs3, 4000, 26)

Set rng = wks.Range("T31")

Set rs4 = CurrentDb.OpenRecordset("SELECT tbl_ENCAP.RawMaterial, tbl_ENCAP.Solution, tbl_ENCAP.Color, tbl_ENCAP.Quantity, tbl_ENCAP.UoM " _
  & "FROM tbl_ENCAP " _
  & "WHERE (((tbl_ENCAP.BP)='" & [Forms]![frm_Formulation]![BP] & "') AND ((tbl_ENCAP.Item)='" & [Forms]![frm_Formulation]![Item] & "') " _
  & "AND ((tbl_ENCAP.BillType)='" & [Forms]![frm_Formulation]![BILL TYPE] & "')) AND ((tbl_ENCAP.Old)=No);")

  wks.Cells(29, 20).Value = "Encapsulation"

    For Each fld In rs3.Fields
        wks.Cells(30, cnt - 7).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs4, 4000, 26)

rs1.Close
Set rs1 = Nothing

rs2.Close
Set rs2 = Nothing

rs3.Close
Set rs3 = Nothing

rs4.Close
Set rs4 = Nothing

With wks.Range("A1:P1, T2:X2, T16:X16, T30:X30")
    .EntireColumn.AutoFit
    .Font.Bold = True
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 1
    .HorizontalAlignment = xlCenter
End With

With wks.Range("G:G, I:I, J:J, N:N")
    .NumberFormat = "0.00%"
End With

appExcel.Visible = True

结束子

将 (4) Forms/Subforms 查询和 table 数据导出到 Excel

Export (4) Forms/Subforms query and table data to Excel

ms-access

vba

ms-access-2016