'==================
'过程：生成发货统计
'==================
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
WD=327950288;"