Office中国论坛/Access中国论坛

标题: 请教：如何将ACESS的记录生成一个EXCEL/WORD文件 [打印本页]

作者: fujy 时间: 2006-12-25 18:30
标题: 请教：如何将ACESS的记录生成一个EXCEL/WORD文件
各位高手，现在遇到一个很难办的问题：我们公司的设备测试记录想有ACESS做（这样便于保存），希望1条记录对应的是一台设备的，但是有时客户需要看这些记录，又希望我们打印给他们的是一台设备对应一张表格，那么我们该如何实现呢，请赐教！不胜感激！

作者: sgrshh29 时间: 2006-12-25 19:32
直接做成报表很方便.

作者: baije 时间: 2006-12-25 19:50
用DAO吧

Public Sub sendtyt()
On Error GoTo errs
DoCmd.SetWarnings False
DoCmd.OpenQuery "推移图生成表查询"    '运行生成表查询，因为ADO有时不认存在条件的查询语句与SQL语句
DoCmd.OpenQuery "推移图接单下月汇总"
DoCmd.SetWarnings True

Dim xlapp As Excel.Application
Dim xlBOOK As Workbook, xlSHEET As Worksheet
Dim TableA As Variant, DB As Database, Wks As Workspace
Dim mymonth, myyear

myyear = Format([Forms]![推移图窗体]![年], "0000")
mymonth = Format([Forms]![推移图窗体]![月], "00")

Dim strSource As String '打开的EXCEL空表
Dim strRecord As String '打开的查询或表名称

strSource = mepath & "dll\tyt.xlt"
strRecord = "推移图"

If dirfile(strSource) = False Then MsgBox "找不到模板，请找系统管理员处理！" & "或询问程式作者处理方式！", 16: GoTo errs
'xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL中的启动宏

Set DB = CurrentDb()
Set TableA = DB.OpenRecordset(strRecord) '打开查询strRecord dbOpenDynaset

'If TableA.EOF Then MsgBox "无记录!" & vbCrLf & "无法生成推移图！", 64: GoTo errs2
Set xlapp = CreateObject("Excel.Application")
Set xlapp = New Excel.Application
xlapp.Visible = False '显示EXCEL表格

Set xlBOOK = xlapp.Workbooks.Open(strSource)

Set xlSHEET = xlBOOK.Worksheets(1)
Set Wks = Workspaces(0)

xlSHEET.cells(24, 2) = IIf(Val(mymonth) = 1, "12", Format(Val(mymonth) - 1, "00")) & "月未完成单"
xlSHEET.cells(24, 3) = IIf(Val(mymonth) = 1, "12", Format(Val(mymonth) - 1, "00")) & "月接" & mymonth & "月订单"
xlSHEET.ChartObjects(1).Chart.ChartTitle.Text = myyear & "年" & mymonth & "月份销售接单与出货推移图"

TableA.MoveFirst

Dim cel As Integer

For i = 0 To 30
      cel = i + 4

      xlSHEET.cells(25, cel) = Val(TableA!接单数量)
      xlSHEET.cells(27, cel) = Val(TableA!出货数量)
      If Val(TableA!接单数量) = 0 Then xlSHEET.cells(25, cel).Font.ColorIndex = 3
      If Val(TableA!出货数量) = 0 Then xlSHEET.cells(27, cel).Font.ColorIndex = 3
      If TableA!周 = 1 Then xlSHEET.cells(24, cel).Font.ColorIndex = 3
      TableA.MoveNext
Next i

TableA.Close
strRecord = "上月下单"
Set TableA = DB.OpenRecordset(strRecord)
xlSHEET.cells(25, 3) = TableA!数量
TableA.Close

xlSHEET.Range("b29").Select

xlapp.ActiveWorkbook.SaveAs (myyear & "年" & mymonth & "月推移图.xls")
xlapp.Visible = True

errs2:
Set xlapp = Nothing
Set xlSHEET = Nothing
Set xlBOOK = Nothing
Set xlSHEET = Nothing
Set Wks = Nothing
Set TableA = Nothing
Set DB = Nothing

Exit Sub
errs:
If err = 1004 Then
      '[Forms]![货款结算]![确定].SetFocus
      MsgBox (myyear & "年" & mymonth & "月推移图.xls") & "已打开，文件无法保存！"
      xlapp.Visible = True
      Exit Sub
Else
      MsgBox "未定义错误，请告知程式作者" & err & Error, 16
End If
GoTo errs2
End Sub

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