Office中国论坛/Access中国论坛

标题: (解决,谢谢todaynew 和a508)为什么子窗体数据没有导出来? [打印本页]

作者: kfzhigen 时间: 2009-12-17 12:47
标题: (解决,谢谢todaynew 和a508)为什么子窗体数据没有导出来?
本帖最后由 kfzhigen 于 2009-12-25 13:24 编辑

请教为什么套用了<如何将主子窗体一起导到EXCE>里的代码,为什么只导出主表而子窗体里的数据没有导出!!!
帮忙看看哪里出错了???

作者: linjingdr 时间: 2009-12-17 21:49
没见到你的导出方法呀？

作者: kfzhigen 时间: 2009-12-18 09:41
Private Sub 导出_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
Dim fname As String
Dim shtname As String
On Error GoTo 导出_Err
fname = GetFolder                                                    '打开文件夹并选取文件
shtname = InputBox("请选择表:", "表选择窗体", "Sheet1")                '指定导出到的工作表（Sheet）名称
sql = "select * from 订单明细 where 生产号=" & Me.生产号
rs.Open sql, CurrentProject.Connection, adOpenKeyset, adLockOptimistic  '打开记录集
Set xlApp = CreateObject("Excel.Application")                         '创建一个Excel实例
xlApp.Application.Visible = True                                     '使Excel可见
Set xlBook = xlApp.Workbooks.Open(fname)                               '打开Excel工作簿
'导出主表
xlBook.Application.Sheets(shtname).Select                            '按指定名称选择工作表
xlBook.Application.Range("A1").Value = "生产号"
xlBook.Application.Range("A2").Value = "客户"
xlBook.Application.Range("C1").Value = "车间"
xlBook.Application.Range("C2").Value = "下单日期"
xlBook.Application.Range("B1").Value = Me.生产号
xlBook.Application.Range("B2").Value = Me.客户
xlBook.Application.Range("D1").Value = Me.车间
xlBook.Application.Range("D2").Value = Me.下单日期
'导出子表
xlBook.Application.Cells(4, 1).Value = "序号"
xlBook.Application.Cells(4, 2).Value = "生产号"
xlBook.Application.Cells(4, 3).Value = "客户订单号"
xlBook.Application.Cells(4, 4).Value = "型号规格"
xlBook.Application.Cells(4, 5).Value = "产品名称"
xlBook.Application.Cells(4, 6).Value = "材质"
xlBook.Application.Cells(4, 7).Value = "数量"
xlBook.Application.Cells(4, 8).Value = "交货日期"

For i = 1 To rs.RecordCount
xlBook.Application.Cells(i + 4, 1).Value = rs("序号")
xlBook.Application.Cells(i + 4, 2).Value = rs("生产号")
xlBook.Application.Cells(i + 4, 3).Value = rs("客户订单号")
xlBook.Application.Cells(i + 4, 4).Value = rs("型号规格")
xlBook.Application.Cells(i + 4, 5).Value = rs("产品名称")
xlBook.Application.Cells(i + 4, 6).Value = rs("材质")
xlBook.Application.Cells(i + 4, 7).Value = rs("数量")
xlBook.Application.Cells(i + 4, 8).Value = rs("交货日期")
rs.MoveNext
Next

xlApp.Quit
rs.Close
Set xlApp = Nothing
Set xlBook = Nothing

导出_Exit:
Exit Sub
导出_Err:
MsgBox "数据错误，请检查！"
Resume 导出_Exit
End Sub

??没有?

作者: kfzhigen 时间: 2009-12-18 15:47
Public Function GetFolder() As String
'文件及文件夹路径函数
Dim dlgOpen As FileDialog
Dim i As Long, j As Long
Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
With dlgOpen
      .AllowMultiSelect = True
      .Show
End With
i = dlgOpen.SelectedItems.Count
If i > 0 Then
      GetFolder = ""
      For j = 2 To i
         GetFolder = GetFolder & dlgOpen.SelectedItems(j) & ";"
      Next
      j = 1
      GetFolder = GetFolder & dlgOpen.SelectedItems(j)
Else
      GetFolder = CurDir() & "\"
End If
Set dlgOpen = Nothing
End Function

作者: kfzhigen 时间: 2009-12-18 15:48
哪里出错,请教!!

作者: kfzhigen 时间: 2009-12-19 09:29
再次请教:为什么数据库中主表与子表中的关系主键为什么一定是自动编号啊?为什么主键设为文本就不能导出子窗体???

作者: todaynew 时间: 2009-12-19 18:43
本帖最后由 todaynew 于 2009-12-19 18:44 编辑

呵呵，好像是套用我写的一个实例。
不必是自动编号。只需修改以下语句即可：
sql = "select * from 订单明细 where 生产号='" & Me.生产号.Value & "'"

此外在xlApp.Quit语句前可加xlBook.Save，这样可以省掉一个系统应答。

作者: a508 时间: 2009-12-19 21:50
sql = "select * from 订单明细 where 生产号=" & Me.生产号

sql = "select * from 订单明细 where 生产号=" & "'" & Me.生产号 & "'"
文本数据类型是要单引号的.
不过学习了.

作者: kfzhigen 时间: 2009-12-20 10:28
哦,原来如此!非常感谢!!

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