如何实现这种导出？

goto2008

请教如何将主子窗体的记录一起导到EXCEL。。。
这种导出比单独导一个子窗体来得难些。。
不清楚格式要怎么整才好。
在EXCEL里，最好是把主窗的资料放在上面。。然后子窗体的放在下面。虚心请教。

像：
EXCEL第1行----票ID：1       进货日期：2009-10-10        制单人：张三
EXCEL第2行----产品    数量
EXCEL第3行----XXX    XXX
EXCEL第4行----XXX    XXX

todaynew

请教如何将主子窗体的记录一起导到EXCEL。。。
这种导出比单独导一个子窗体来得难些。。
不清楚格式要怎么整才好。
在EXCEL里，最好是把主窗的资料放在上面。。然后子窗体的放在下面。虚心请教。

像：
EXCEL第 ...
goto2008 发表于 2009-12-7 01:09

Public Function GetFile() As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
    .AllowMultiSelect = True
    .Show
End With
GetFile = dlgOpen.SelectedItems(1)
Set dlgOpen = Nothing
End Function

Private Sub 导到EXCEL_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim rs As New ADODB.Recordset
Dim sql As String
Dim i As Long, j As Long, m As Long
Dim fname As String
On Error GoTo 导出_Err
fname = GetFile
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
Set xlBook = xlApp.Workbooks.Open(fname)
DoCmd.GoToRecord acDataForm, "主窗", acFirst
m = 0
For j = 1 To DCount("*", "主表")
    sql = "select * from 子表 where 票ID=" & Me.票ID.Value
    rs.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    '导出主表
    xlBook.Application.Sheets("Sheet1").Select
    xlBook.Application.Cells(m + 1, 1).Value = "票ID"
    xlBook.Application.Cells(m + 2, 1).Value = "进货日期"
    xlBook.Application.Cells(m + 3, 1).Value = "制单人"
    xlBook.Application.Cells(m + 1, 2).Value = Me.票ID.Value
    xlBook.Application.Cells(m + 2, 2).Value = Me.进货日期.Value
    xlBook.Application.Cells(m + 3, 2).Value = Me.制单人.Value
    '导出子表
    xlBook.Application.Cells(m + 4, 1).Value = "产品ID"
    xlBook.Application.Cells(m + 4, 2).Value = "票ID"
    xlBook.Application.Cells(m + 4, 3).Value = "产品"
    xlBook.Application.Cells(m + 4, 4).Value = "数量"
    For i = 1 To rs.RecordCount
        xlBook.Application.Cells(m + i + 4, 1).Value = rs("产品ID")
        xlBook.Application.Cells(m + i + 4, 2).Value = rs("票ID")
        xlBook.Application.Cells(m + i + 4, 3).Value = rs("产品")
        xlBook.Application.Cells(m + i + 4, 4).Value = rs("数量")
        rs.MoveNext
    Next
    m = m + i + 4 + 1
    rs.Close
    DoCmd.GoToRecord acDataForm, "主窗", acNext
Next
DoCmd.GoToRecord acDataForm, "主窗", acFirst
xlBook.Save
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
导出_Exit:
    Exit Sub
导出_Err:
    MsgBox "数据错误，请检查！"
    Resume 导出_Exit
End Sub

goto2008

谢谢todaynew 。。我好好瞄瞄。。

todaynew

在中间加一段代码，可以清除表中原来的内容：
。。。。。
xlApp.Application.Visible = True
Set xlBook = xlApp.Workbooks.Open(fname)
xlBook.Application.Sheets("Sheet1").Select
xlBook.Application.Cells.Select
xlBook.Application.Selection.ClearContents
xlBook.Application.Range("A1").Select
DoCmd.GoToRecord acDataForm, "主窗", acFirst
。。。。。

goto2008

大哥，你这样变成导出表里当所记录。。。。。汗。
我是想导出当前主子窗体对应ID关联的记录。。。。

todaynew

大哥，你这样变成导出表里当所记录。。。。。汗。
我是想导出当前主子窗体对应ID关联的记录。。。。
goto2008 发表于 2009-12-7 11:45

呵呵，那很简单呀。把第一层循环停掉就可以了。

Private Sub 导到EXCEL_Click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim rs As New ADODB.Recordset
Dim sql As String
Dim i As Long, j As Long
Dim fname As String
On Error GoTo 导出_Err
fname = GetFile
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
Set xlBook = xlApp.Workbooks.Open(fname)
xlBook.Application.Sheets("Sheet1").Select
xlBook.Application.Cells.Select
xlBook.Application.Selection.ClearContents
xlBook.Application.Range("A1").Select
sql = "select * from 子表 where 票ID=" & Me.票ID.Value
rs.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'导出主表
xlBook.Application.Cells(1, 1).Value = "票ID"
xlBook.Application.Cells(2, 1).Value = "进货日期"
xlBook.Application.Cells(3, 1).Value = "制单人"
xlBook.Application.Cells(1, 2).Value = Me.票ID.Value
xlBook.Application.Cells(2, 2).Value = Me.进货日期.Value
xlBook.Application.Cells(3, 2).Value = Me.制单人.Value
'导出子表
xlBook.Application.Cells(4, 1).Value = "产品ID"
xlBook.Application.Cells(4, 2).Value = "票ID"
xlBook.Application.Cells(4, 3).Value = "产品"
xlBook.Application.Cells(4, 4).Value = "数量"
For i = 1 To rs.RecordCount
        xlBook.Application.Cells(i + 4, 1).Value = rs("产品ID")
        xlBook.Application.Cells(i + 4, 2).Value = rs("票ID")
        xlBook.Application.Cells(i + 4, 3).Value = rs("产品")
        xlBook.Application.Cells(i + 4, 4).Value = rs("数量")
        rs.MoveNext
Next
   
rs.Close
xlBook.Save
xlApp.Quit
Set xlApp = Nothing
Set xlBook = Nothing
导出_Exit:
    Exit Sub
导出_Err:
    MsgBox "数据错误，请检查！"
    Resume 导出_Exit
End Sub