将access窗体数据导入到EXCEL模板的指定的单元格???

土豆

我以前写的一个脚本文件，你自己参考着看看

'==================
'过程：生成发货统计
'==================
Sub CreateOutSum()
'声明变量
Dim Conn        '连接对象
Dim strConn     '连接字符串
Dim Rs    '记录集对象
Dim strDate    '查询日期
Dim GoodsID, GoodsName, Title   '产品编码,产品名称,报表标题
Dim xApp, xBook, xSheet 'EXCEL对象
Dim ID  '行计数器

    '获取日期
    strDate = InputBox("请输入查询的起始日期", "发货统计")
    If Not IsDate(strDate) Then
        MsgBox "日期格式错误！"
        Exit Sub
    End If
    '获取产品代码
    GoodsID = InputBox("请输入要查询的产品编码", "发货统计")
    If GoodsID = "" Then Exit Sub
    '初始化数据连接
    strConn = "DBQ=data.mdb;DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)}WD=327950288;"
    Set Conn = CreateObject("adodb.connection")
    Conn.Open strConn
    '检查产品代码
    Set Rs = Conn.Execute("select * from 货品档案 where GoodsID='" & GoodsID & "'")
    If Rs.EOF Then
        MsgBox "该产品不存在！"
        Exit Sub
    End If
    GoodsName = Rs("GoodsName")
    Title = "发货统计(" & Trim(Replace(Replace(GoodsName, "/", "-"), "\", "-")) & ")"
    '创建EXCEL对象
    Set xApp = CreateObject("excel.application")
    Set xBook = xApp.Workbooks.Open("c:\demo3.xls")
    xBook.SaveAs "c:\" & Title & ".xls"
    Set xSheet = xBook.Worksheets("Sheet1")
    xSheet.Range("A1") = Title
    xSheet.Range("I5") = DateValue(strDate)
    '填写每日发货量
    For i = 0 To 9
        Set Rs = Conn.Execute("SELECT Sum(Num) AS SumNum " & _
                              "FROM 发生记录 " & _
                              "WHERE ModeID='F1' And GoodsID='" & GoodsID & "' And ([Date]=#" & DateAdd("d", i, strDate) & "#) ")
        If Not Rs.EOF Then xSheet.Range("J" & (i + 5)) = Rs("SumNum")
    Next
    '填写各公司发货量
    ID = 0
    Set Rs = Conn.Execute("SELECT Sum(Num) As SumNum,First(ClientName) As FirstClientName " & _
                        "FROM 发生记录 INNER JOIN 客户档案 ON 客户档案.ClientID=发生记录.ClientID " & _
                        "WHERE ModeID='F1' And GoodsID='" & GoodsID & "' And ([Date] BETWEEN #" & strDate & "# AND #" & DateValue(strDate) + 9 & "#)" & _
                        "GROUP BY 客户档案.ClientID")
    Do While Not Rs.EOF
        xSheet.Range("K" & (ID + 5)) = Rs("FirstClientName")
        xSheet.Range("L" & (ID + 5)) = Rs("SumNum")
        ID = ID + 1
        Rs.movenext
    Loop
    '保存调拨单
    Set xSheet = Nothing
    xBook.Close True
    Set xBook = Nothing
    '释放对象变量
    xApp.Quit: Set xApp = Nothing
    Rs.Close: Set Rs = Nothing
    Conn.Close: Set Conn = Nothing

    MsgBox "发货统计已经创建完毕！"
End Sub