请教：如何将ACESS的记录生成一个EXCEL/WORD文件

fujy

各位高手，现在遇到一个很难办的问题：我们公司的设备测试记录想有ACESS做（这样便于保存），希望1条记录对应的是一台设备的，但是有时客户需要看这些记录，又希望我们打印给他们的是一台设备对应一张表格，那么我们该如何实现呢，请赐教！不胜感激！

sgrshh29

直接做成报表很方便.

baije

用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