Office中国论坛/Access中国论坛

标题: 如何实现这种导出？ [打印本页]

作者: goto2008 时间: 2009-12-7 01:09
标题: 如何实现这种导出？
本帖最后由 goto2008 于 2009-12-7 01:15 编辑

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

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

作者: todaynew 时间: 2009-12-7 10:03

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

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

[attach]40667[/attach]

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 时间: 2009-12-7 11:00
谢谢todaynew 。。我好好瞄瞄。。

作者: todaynew 时间: 2009-12-7 11:16
在中间加一段代码，可以清除表中原来的内容：
。。。。。
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 时间: 2009-12-7 11:45
大哥，你这样变成导出表里当所记录。。。。。汗。
我是想导出当前主子窗体对应ID关联的记录。。。。

作者: todaynew 时间: 2009-12-7 12:15

大哥，你这样变成导出表里当所记录。。。。。汗。
我是想导出当前主子窗体对应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

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)