货品库存管理系统-单机版（1） VBA代码 源代码分析 Access数据库管理系统
代码较多，建议复制代码至本地文档后可按窗体名称搜索
出库单查询
Option Compare Database
Option Explicit
Private Sub Command查询_Click()
On Error GoTo 结束查询
Dim search_field As String
If Me.查询字段 = "出库日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
ck_filter = search_field & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
Me.数据表子窗体.Form.Filter = ck_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
ck_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If Me.查询字段 = "金额" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
ck_filter = search_field & " >= " & Me.最小 & " And " & search_field & " <= " & Me.最大
Me.数据表子窗体.Form.Filter = ck_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
ck_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
ck_filter = search_field & " like '*" & Me.查询内容 & "*'"
Me.数据表子窗体.Form.Filter = ck_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
ck_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command全部_Click()
ck_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command数据导出_Click()
On Error GoTo 导出失败
'------------------------------------------------清空表数据
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 导出出库单表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
ck_filter = Me.数据表子窗体.Form.Filter
If ck_filter <> "" And Me.数据表子窗体.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 出库单查询 " & " Where " & ck_filter
Else
dflink_sql = "SELECT * FROM 出库单查询"
End If
ck_order = Me.数据表子窗体.Form.OrderBy
If ck_order <> "" Then
dflink_sql = dflink_sql & " order by " & ck_order
End If
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("导出出库单表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!出库单号.Value = !出库单号.Value
add_rs!领用单位.Value = !领用单位.Value
add_rs!出库类别.Value = !出库类别.Value
add_rs!出库日期.Value = !出库日期.Value
add_rs!领取人.Value = !领取人.Value
add_rs!经办人.Value = !经办人.Value
add_rs!备注.Value = !备注.Value
add_rs!金额.Value = !金额.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
Call 导出查询表结果("导出出库单表")
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
DoCmd.OpenForm "出库单添加", acNormal
End Sub
Private Sub Form_Load()
DoCmd.Restore
ck_filter = ""
ck_order = "出库单号 DESC"
'Me.数据表子窗体.Form.OrderBy = ck_order
'Me.数据表子窗体.Form.OrderByOn = True
Me.查询内容.Visible = True
'-----------------------------隐藏日期控件
Me.起始日期.Visible = False
Me.截止日期.Visible = False
'-----------------------------隐藏金额控件
Me.最小.Visible = False
Me.最大.Visible = False
End Sub
Private Sub 查询字段_Change()
If Me.查询字段 = "出库日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
If Me.查询字段 = "金额" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
End Sub
出库单查询数据表
Private Sub 出库单号_DblClick(Cancel As Integer)
ck_num = 出库单号
DoCmd.OpenForm "出库单管理", acNormal, , "出库单号='" & 出库单号 & "'"
End Sub
出库单管理
Option Compare Database
Option Explicit
Public update_num As Integer
Private Sub Command更新_Click()
On Error Resume Next
If 出库单号 = "" Or IsNull(出库单号) = True Then
MsgBox "出库单号值为空！"
Exit Sub
End If
If 出库日期 = "" Or IsNull(出库日期) = True Then
MsgBox "出库日期值为空！"
Exit Sub
End If
update_num = 1
If MsgBox("是否更新该记录", vbYesNo) <> vbYes Then
DoCmd.RunCommand acCmdUndo
Exit Sub
End If
DoCmd.SetWarnings (False)
On Error Resume Next
DoCmd.RunCommand acCmdSaveRecord
ck_num = Me.出库单号
Exit Sub
If Error.Number <> 0 Then
MsgBox Error.Description
Else
End If
End Sub
Private Sub Command出库单_Click()
On Error GoTo outputerror
'------------------------------------------
Dim copyfilename As String
copyfilename = "出库单.xlsx" '要复制的源文件（Excel）
'---------------------------------输入文件名
Dim outputname As String
outputname = InputBox("请输入导出的文件名", "导出出库单", "出库单" & Me.出库单号) '---------------------------------------------------输入要生成的表名
If outputname = "" Or IsNull(outputname) Then '为空则不执行程序
'GoTo outputerror
Exit Sub
End If
'----------------------------------选择导出的位置（文件夹）
Dim exportpath As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
With dlgOpen
If .Show = -1 Then
exportpath = .SelectedItems(1)
Else
Exit Sub
End If
End With
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
fs.copyfile fs.BuildPath(CurrentProject.Path, copyfilename), exportpath & "\" & outputname & ".xlsx"
'================================================================================打开创建的表并处理数据
Dim excelopenpathname As String
excelopenpathname = exportpath & "\" & outputname & ".xlsx" '复制粘贴新Excel文件的路径和名称
'================================================================================处理打开的表数据
Dim xlapp As Object
Set xlapp = CreateObject("excel.application")
Dim xlwbk As Object
Dim xlwsh As Object
Dim CreateExcel As Object
Set CreateExcel = xlapp
xlapp.Visible = False
Set xlwbk = xlapp.WorkBooks.Open(excelopenpathname)
xlwbk.Activate
Set xlwsh = xlwbk.Worksheets(1)
With xlwsh
'--------------------------------------------------处理过程
.cells(1, "K").Value = Me.出库单号.Value
.cells(3, "D").Value = Me.领用单位.Value
.cells(3, "H").Value = Me.出库类别.Value
.cells(3, "K").Value = Me.出库日期.Value
.cells(6, "K").Value = Me.金额.Value
.cells(7, "D").Value = Me.领取人.Value
.cells(7, "K").Value = Me.经办人.Value
.cells(8, "D").Value = Me.备注.Value
.cells(6, "D").Value = rmb(Me.金额)
End With
'Set xlwsh = xlwbk.Worksheets(2)
With xlwsh
'****************************************************************循环采购出库查询
Dim search_sql As String
search_sql = "SELECT * FROM 出库明细查询 " & " Where 出库单号='" & Me.出库单号 & "' Order by 出库序号 ASC"
Dim search_rs As DAO.Recordset
'MsgBox search_sql
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
'------------------------------------------------------------------
Dim add_row As Long
add_row = 5
Do While search_rs.EOF = False
.rows(add_row).Insert
.cells(add_row, 2).Value = search_rs!出库序号.Value
.cells(add_row, 3).Value = search_rs!货品编号.Value
.cells(add_row, 4).Value = search_rs!货品名称.Value
.cells(add_row, 5).Value = search_rs!规格型号.Value
.cells(add_row, 6).Value = search_rs!货品类别.Value
.cells(add_row, 9).Value = search_rs!单位.Value
.cells(add_row, 7).Value = search_rs!单价.Value
.cells(add_row, 8).Value = search_rs!数量.Value
.cells(add_row, 10).Value = search_rs!货品金额.Value
.cells(add_row, 11).Value = search_rs!明细备注.Value
add_row = add_row + 1
search_rs.MoveNext
Loop
'------------------------------------------------------------------
search_rs.Close
Set search_rs = Nothing
'****************************************************************
End With
xlwbk.Save
xlwbk.Close
xlapp.Quit
MsgBox "导出完成"
'------------------------------------------
Exit Sub
outputerror:
MsgBox "导出数据出错，请检查！可能存在同名工作簿" & vbCrLf & Err.Description
End Sub
Private Sub Command删除_Click()
If MsgBox("是否删除该记录", vbYesNo) <> vbYes Then
Exit Sub
End If
On Error Resume Next
DoCmd.SetWarnings (False)
DoCmd.RunCommand acCmdDeleteRecord
MsgBox "删除成功"
DoCmd.Close acForm, Me.Name
If Error.Number <> 0 Then
MsgBox Error.Description
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
On Error GoTo 数据更新前提醒_Err
If update_num = 1 Then
update_num = 0
Exit Sub
End If
If (MsgBox("是否保存对出库单记录修改", 1, "修改记录提醒") = 1) Then
Beep
' MsgBox "记录修改成功", vbyesOnly, "提醒"
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
' Exit Function
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Close()
On Error Resume Next
Forms("出库单查询").数据表子窗体.Requery
End Sub
Private Sub Form_Load()
ck_num = Me.出库单号
Me.金额 = Nz(DLookup("金额", "出库单金额查询", "出库单号='" & Me.出库单号 & "'"), 0)
End Sub
Private Sub 选择货品_Change()
If Me.选择货品 <> "" Then
Me.货品库存 = Nz(DLookup("当前库存", "库存统计查询", "货品编号='" & Me.选择货品 & "'"), 0)
Else
Me.货品库存 = ""
End If
End Sub
出库单添加
Option Compare Database
Option Explicit
Private Sub Command导入_Click()
On Error GoTo inputerror
Dim upfilename As String
Dim dlgOpen As FileDialog
Set dlgOpen = Application.FileDialog(msoFileDialogFilePicker)
With dlgOpen
.AllowMultiSelect = False
.Filters.Add "Excel", "*.xlsx; *.xlsm", 1
If .Show = -1 Then
upfilename = .SelectedItems(1)
Else
Exit Sub
End If
End With
'------------------------------------------------清空表数据
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 本地出库单表"
DoCmd.RunSQL del_sql
'------------------------------------------
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("本地出库单表", dbOpenTable)
'打开创建的表并处理数据
Dim excelopenpathname As String
excelopenpathname = upfilename '复制粘贴新Excel文件的路径和名称
'处理打开的表数据
Dim xlapp As excel.Application
Dim xlwbk As excel.Workbook
Dim xlwsh As excel.Worksheet
Set xlapp = New excel.Application
Dim CreateExcel As Object
Set CreateExcel = xlapp
xlapp.Visible = True
Set xlwbk = xlapp.WorkBooks.Open(excelopenpathname)
xlwbk.Activate
Set xlwsh = xlwbk.Worksheets(1)
With xlwsh
Dim i
On Error Resume Next
'--------------------------------------------------处理过程
If .cells(2, 1).Value <> "" Then
Else
GoTo exitexcel
End If
For i = 2 To .Range("A1").End(xlDown).Row
add_rs.AddNew
add_rs!出库单号.Value = .cells(i, 1).Value
add_rs!领用单位.Value = .cells(i, 2).Value
add_rs!出库类别.Value = .cells(i, 3).Value
add_rs!出库日期.Value = .cells(i, 4).Value
add_rs!领取人.Value = .cells(i, 5).Value
add_rs!经办人.Value = .cells(i, 6).Value
add_rs!备注.Value = .cells(i, 7).Value
add_rs.Update
Next i
End With
exitexcel:
xlwbk.Save
xlwbk.Close
xlapp.Quit
'------------------------------------------
Me.数据表子窗体.Requery
Exit Sub
inputerror:
MsgBox Err.Description
End Sub
Private Sub Command清空_Click()
出库单号.Value = 生成出库单号(Date)
领用单位.Value = ""
出库类别.Value = ""
出库日期.Value = Date
领取人.Value = ""
经办人.Value = ""
备注.Value = ""
End Sub
Private Sub Command上传_Click()
On Error GoTo 上传数据失败错误
If MsgBox("是否将数据添加至出库单表，注意：重复的出库单号将不会添加", vbOKCancel) <> vbOK Then
Exit Sub
End If
If Nz(DCount("出库单号", "本地出库单表"), 0) = 0 Then '上传出库单记录数量
Exit Sub
End If
'---------------------------------------------------------------查询前端
Dim search_rs As DAO.Recordset
Dim search_sql As String
search_sql = "Select * From 本地出库单表"
Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)
'---------------------------------------------------------------建立查询
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("出库单表", dbOpenTable)
'---------------------------------------------------------------
On Error Resume Next
Do While search_rs.EOF = False
add_rs.AddNew
add_rs!出库单号.Value = search_rs!出库单号.Value
add_rs!领用单位.Value = search_rs!领用单位.Value
add_rs!出库类别.Value = search_rs!出库类别.Value
add_rs!出库日期.Value = search_rs!出库日期.Value
add_rs!领取人.Value = search_rs!领取人.Value
add_rs!经办人.Value = search_rs!经办人.Value
add_rs!备注.Value = search_rs!备注.Value
add_rs.Update
search_rs.MoveNext
Loop
'---------------------------------------------------------------断开后端链接
add_rs.Close
Set add_rs = Nothing
'---------------------------------------------------------------断开前端链接
search_rs.Close
Set search_rs = Nothing
MsgBox "上传数据完成"
Exit Sub
上传数据失败错误:
MsgBox "上传数据失败！" & vbCrLf & Err.Description
End Sub
Private Sub Command添加_Click()
On Error GoTo 添加失败错误
If 出库单号 = "" Or IsNull(出库单号) = True Then
MsgBox "出库单号值为空！"
Exit Sub
End If
If 出库日期 = "" Or IsNull(出库日期) = True Then
MsgBox "出库日期值为空！"
Exit Sub
End If
If Nz(DCount("出库单号", "出库单表", "出库单号='" & Me.出库单号 & "'"), 0) > 0 Then
MsgBox "该出库单号已存在！"
Exit Sub
End If
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("出库单表", dbOpenTable)
add_rs.AddNew
'--------------------------------------------------------------字段赋值
On Error Resume Next
With add_rs
add_rs!出库单号.Value = 出库单号.Value
add_rs!领用单位.Value = 领用单位.Value
add_rs!出库类别.Value = 出库类别.Value
add_rs!出库日期.Value = 出库日期.Value
add_rs!领取人.Value = 领取人.Value
add_rs!经办人.Value = 经办人.Value
add_rs!备注.Value = 备注.Value
'add_rs!金额.Value = 金额.Value
End With
'----------------------------------------------------------
add_rs.Update
add_rs.Close
Set add_rs = Nothing
'----------------------------------------------------------
MsgBox "添加成功！"
Call Command清空_Click
Exit Sub
添加失败错误:
MsgBox Err.Description
End Sub
Private Sub Form_Close()
On Error Resume Next
ck_filter = ""
Forms("出库单查询").数据表子窗体.Requery
End Sub
Private Sub Form_Load()
DoCmd.Restore
Me.出库日期 = Date
Me.出库单号 = 生成出库单号(Date)
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 本地出库单表"
DoCmd.RunSQL del_sql
Me.数据表子窗体.Requery
End Sub
Private Sub 出库单号_DblClick(Cancel As Integer)
If Me.出库日期 <> "" Then
Me.出库单号 = 生成出库单号(Me.出库日期)
Else
Me.出库单号 = 生成出库单号(Date)
End If
End Sub
Private Sub 出库日期_DblClick(Cancel As Integer)
Me.出库日期 = Date
End Sub
Function 生成出库单号(ByVal numdate As Date) As String
On Error GoTo 错误
Dim search_num As String
search_num = "CK" & Format(numdate, "YYYYMMDD")
Dim num_count As Long
num_count = Nz(DCount("出库单号", "出库单表", "出库单号 like '*" & search_num & "*'"), 0) + 1
生成出库单号 = search_num & "" & Format(num_count, "000")
Exit Function
错误:
生成出库单号 = ""
End Function
出库类别数据表
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
' MsgBox "记录修改成功", vbyesOnly, "提醒"
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
' Exit Function
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
出库明细查询数据表
Option Compare Database
Public maxid As Long
Private Sub Form_AfterUpdate()
On Error Resume Next
Forms("出库单管理").金额 = Nz(DLookup("金额", "出库单金额查询", "出库单号='" & Forms("出库单管理").出库单号 & "'"), 0)
If Forms("出库单管理").选择货品 = Me.货品编号 Then
Forms("出库单管理").货品库存 = Nz(DLookup("当前库存", "库存统计查询", "货品编号='" & Me.货品编号 & "'"), 0)
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对出入库明细记录的修改", 1, "修改记录提醒") = 1) Then
Beep
' MsgBox "记录修改成功", vbyesOnly, "提醒"
' Me.货品编号.RowSource = ""
' Me.货品编号.RowSource = "SELECT 货品表.货品编号, 货品表.货品名称, 货品表.货品类别, 库存统计查询.当前库存 FROM 货品表 INNER JOIN 库存统计查询 ON 货品表.货品编号 = 库存统计查询.货品编号"
maxid = Nz(DMax("出库明细ID", "出库明细表", "出库单号='" & Forms("出库单管理").出库单号 & "'"), 0)
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
' Exit Function
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
Private Sub Form_Load()
maxid = Nz(DMax("出库明细ID", "出库明细表", "出库单号='" & Forms("出库单管理").出库单号 & "'"), 0)
End Sub
Private Sub Form_Timer()
If ckhp_num = 1 Then
If Me.货品编号 <> ckhp_text Then
Me.货品编号 = ckhp_text
Me.单价 = Nz(DLookup("出库价", "货品表", "货品编号='" & Me.货品编号 & "'"), 0)
End If
ckhp_num = 0
End If
End Sub
Private Sub 货品编号_AfterUpdate()
Me.单价 = Nz(DLookup("出库价", "货品表", "货品编号='" & Me.货品编号 & "'"), 0)
End Sub
Private Sub 货品编号_Change()
Me.单价 = Nz(DLookup("出库价", "货品表", "货品编号='" & Me.货品编号 & "'"), 0)
End Sub
Private Sub 货品编号_DblClick(Cancel As Integer)
hp_type = 4
DoCmd.OpenForm "货品选择", acNormal
End Sub
Private Sub 数量_BeforeUpdate(Cancel As Integer)
If 数量 <> "" And Me.出库明细ID > maxid Then
Dim 货品库存num As Single
货品库存num = Nz(DLookup("当前库存", "库存统计查询", "货品编号='" & Me.货品编号 & "'"), 0)
If Me.数量 > 货品库存num Then
MsgBox "注意：出库数量大于当前库存数量" & vbCrLf & "当前货品库存: " & 货品库存num & " " & Me.单位
End If
End If
End Sub
出入库明细查询
Option Compare Database
Option Explicit
Private Sub Command查询_Click()
On Error GoTo 结束查询
Dim search_field As String
If Me.查询字段 = "出入库日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
crkmx_filter = search_field & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
Me.数据表子窗体.Form.Filter = crkmx_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
crkmx_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If Me.查询字段 = "单价" Or Me.查询字段 = "数量" Or Me.查询字段 = "货品金额" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
crkmx_filter = search_field & " >= " & Me.最小 & " And " & search_field & " <= " & Me.最大
Me.数据表子窗体.Form.Filter = crkmx_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
crkmx_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
crkmx_filter = search_field & " like '*" & Me.查询内容 & "*'"
Me.数据表子窗体.Form.Filter = crkmx_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
crkmx_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command全部_Click()
crkmx_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command数据导出_Click()
On Error GoTo 导出失败
'------------------------------------------------清空表数据
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 导出出入库明细表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
crkmx_filter = Me.数据表子窗体.Form.Filter
If crkmx_filter <> "" And Me.数据表子窗体.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 出入库明细查询 " & " Where " & crkmx_filter
Else
dflink_sql = "SELECT * FROM 出入库明细查询"
End If
crkmx_order = Me.数据表子窗体.Form.OrderBy
If crkmx_order <> "" Then
dflink_sql = dflink_sql & " order by " & crkmx_order
End If
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("导出出入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!货品名称.Value = !货品名称.Value
add_rs!规格型号.Value = !规格型号.Value
add_rs!货品类别.Value = !货品类别.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!单位.Value = !单位.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs!供领人.Value = !供领人.Value
add_rs!经办人.Value = !经办人.Value
add_rs!出入库类别.Value = !出入库类别.Value
add_rs!供领单位.Value = !供领单位.Value
add_rs!明细备注.Value = !明细备注.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
Call 导出查询表结果("导出出入库明细表")
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
DoCmd.OpenForm "出入库明细添加", acNormal
End Sub
Private Sub Form_Load()
DoCmd.Restore
crkmx_filter = ""
crkmx_order = "出入库日期 DESC"
Me.查询内容.Visible = True
'-----------------------------隐藏日期控件
Me.起始日期.Visible = False
Me.截止日期.Visible = False
'-----------------------------隐藏金额控件
Me.最小.Visible = False
Me.最大.Visible = False
End Sub
Private Sub 查询字段_Change()
If Me.查询字段 = "出入库日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
If Me.查询字段 = "单价" Or Me.查询字段 = "数量" Or Me.查询字段 = "货品金额" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
End Sub
出入库明细查询数据表
Option Compare Database
Option Explicit
Private Sub Command查询_Click()
If Me.起始日期 <> "" And Me.截止日期 <> "" Then
Call 复制入库单明细表(Me.起始日期, Me.截止日期)
Call 复制出库单明细表(Me.起始日期, Me.截止日期)
Call 货品出入库汇总
Else
MsgBox "请选择日期"
Exit Sub
End If
Me.数据表子窗体.Requery
End Sub
Private Sub Command全部_Click()
crkcx_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command数据导出_Click()
On Error GoTo 导出失败
'------------------------------------------------清空表数据
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 导出出入库统计查询表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
crkcx_filter = Me.数据表子窗体.Form.Filter
If crkcx_filter <> "" And Me.数据表子窗体.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 出入库统计查询 " & " Where " & crkcx_filter
Else
dflink_sql = "SELECT * FROM 出入库统计查询"
End If
crkcx_order = Me.数据表子窗体.Form.OrderBy
If crkcx_order <> "" Then
dflink_sql = dflink_sql & " order by " & crkcx_order
End If
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("导出出入库统计查询表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!货品名称.Value = !货品名称.Value
add_rs!规格型号.Value = !规格型号.Value
add_rs!货品类别.Value = !货品类别.Value
add_rs!单位.Value = !单位.Value
add_rs!入库数量.Value = !入库数量.Value
add_rs!入库均价.Value = !入库均价.Value
add_rs!入库金额.Value = !入库金额.Value
add_rs!出库数量.Value = !出库数量.Value
add_rs!出库均价.Value = !出库均价.Value
add_rs!出库金额.Value = !出库金额.Value
add_rs!成本均价.Value = !成本均价.Value
add_rs!成本金额.Value = !成本金额.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
Call 导出查询表结果("导出出入库统计查询表")
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Dim rfdate As Date
Dim rldate As Date
Dim rftext As String
Dim rltext As String
Dim cfdate As Date
Dim cldate As Date
Dim cftext As String
Dim cltext As String
rftext = Nz(DMin("最早入库日期", "入库日期查询"), "")
rltext = Nz(DMax("最后入库日期", "入库日期查询"), "")
cftext = Nz(DMin("最早出库日期", "出库日期查询"), "")
cltext = Nz(DMax("最后出库日期", "出库日期查询"), "")
If (rftext <> "" And rltext <> "") Or (cftext <> "" And cltext <> "") Then
rfdate = CDate(rftext)
rldate = CDate(rltext)
cfdate = CDate(cftext)
cldate = CDate(cltext)
If rfdate < cfdate Then
Me.起始日期 = rfdate
Else
Me.起始日期 = cfdate
End If
If rldate > cldate Then
Me.截止日期 = rldate
Else
Me.截止日期 = cldate
End If
Else
Me.起始日期 = ""
Me.截止日期 = ""
End If
'---------------------------如果日期不为空
If Me.起始日期 <> "" And Me.截止日期 <> "" Then
Call 复制入库单明细表(Me.起始日期, Me.截止日期)
Call 复制出库单明细表(Me.起始日期, Me.截止日期)
Call 货品出入库汇总
Me.数据表子窗体.Requery
End If
End Sub
Sub 复制入库单明细表(ByVal fd As Date, ByVal ld As Date)
On Error GoTo 导出失败
'------------------------------------------------------前期
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 前期入库明细表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 入库单明细查询 Where 出入库日期 <#" & fd & "#"
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("前期入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------期中
DoCmd.SetWarnings (False)
del_sql = "Delete From 期中入库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 入库单明细查询 Where 出入库日期 >=#" & fd & "# and 出入库日期 <=#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("期中入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------后期
DoCmd.SetWarnings (False)
del_sql = "Delete From 后期入库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 入库单明细查询 Where 出入库日期 >#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("后期入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Sub 复制出库单明细表(ByVal fd As Date, ByVal ld As Date)
On Error GoTo 导出失败
'------------------------------------------------------前期
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 前期出库明细表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 出库单明细查询 Where 出入库日期 <#" & fd & "#"
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("前期出库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------期中
DoCmd.SetWarnings (False)
del_sql = "Delete From 期中出库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 出库单明细查询 Where 出入库日期 >=#" & fd & "# and 出入库日期 <=#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("期中出库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------后期
DoCmd.SetWarnings (False)
del_sql = "Delete From 后期出库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 出库单明细查询 Where 出入库日期 >#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("后期出库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Sub 货品出入库汇总()
On Error GoTo 导出失败
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 出入库统计表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 货品表"
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("出入库统计表", dbOpenTable)
'-------------------------
Dim 入库数量num As Single
Dim 出库数量num As Single
Dim 期初库存num As Single
Dim 期初金额num As Currency
Dim 前期入库数量num As Single
Dim 前期入库金额num As Currency
Dim 期中入库数量num As Single
Dim 期中入库金额num As Currency
Dim 成本均价num As Currency
Do While .EOF = False
入库数量num = Nz(DLookup("期中入库数量", "期中入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
出库数量num = Nz(DLookup("期中出库数量", "期中出库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
期初库存num = Nz(!期初库存.Value, 0)
期初金额num = Nz(!期初金额.Value, 0)
前期入库数量num = Nz(DLookup("前期入库数量", "前期入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
前期入库金额num = Nz(DLookup("前期入库金额", "前期入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
期中入库数量num = 入库数量num
期中入库金额num = Nz(DLookup("期中入库金额", "期中入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
If 期中入库数量num + 前期入库数量num + 期初库存num > 0 Then
成本均价num = (期初金额num + 前期入库金额num + 期中入库金额num) / (期中入库数量num + 前期入库数量num + 期初库存num)
Else
成本均价num = 0 '是0还是出库均价
End If
If 入库数量num <> 0 Or 出库数量num <> 0 Then
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!入库数量.Value = 入库数量num
add_rs!入库均价.Value = Nz(DLookup("期中入库均价", "期中入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
add_rs!入库金额.Value = 期中入库金额num
add_rs!出库数量.Value = 出库数量num
add_rs!出库均价.Value = Nz(DLookup("期中出库均价", "期中出库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
add_rs!出库金额.Value = Nz(DLookup("期中出库金额", "期中出库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
add_rs!成本均价.Value = 成本均价num
add_rs!成本金额.Value = 成本均价num * 出库数量num
add_rs.Update
End If
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub 选择货品_Change()
If Me.选择货品 <> "" Then
Me.数据表子窗体.Form.Filter = "货品编号='" & Me.选择货品 & "'"
Me.数据表子窗体.Form.FilterOn = True
Else
Me.数据表子窗体.Form.FilterOn = False
End If
End Sub
'Private Sub 选择货品_DblClick(Cancel As Integer)
'hp_type = 2
'DoCmd.OpenForm "货品选择", acNormal
'End Sub
出入库统计查询
Option Compare Database
Option Explicit
Private Sub Command查询_Click()
If Me.起始日期 <> "" And Me.截止日期 <> "" Then
Call 复制入库单明细表(Me.起始日期, Me.截止日期)
Call 复制出库单明细表(Me.起始日期, Me.截止日期)
Call 货品出入库汇总
Else
MsgBox "请选择日期"
Exit Sub
End If
Me.数据表子窗体.Requery
End Sub
Private Sub Command全部_Click()
crkcx_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command数据导出_Click()
On Error GoTo 导出失败
'------------------------------------------------清空表数据
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 导出出入库统计查询表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
crkcx_filter = Me.数据表子窗体.Form.Filter
If crkcx_filter <> "" And Me.数据表子窗体.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 出入库统计查询 " & " Where " & crkcx_filter
Else
dflink_sql = "SELECT * FROM 出入库统计查询"
End If
crkcx_order = Me.数据表子窗体.Form.OrderBy
If crkcx_order <> "" Then
dflink_sql = dflink_sql & " order by " & crkcx_order
End If
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("导出出入库统计查询表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!货品名称.Value = !货品名称.Value
add_rs!规格型号.Value = !规格型号.Value
add_rs!货品类别.Value = !货品类别.Value
add_rs!单位.Value = !单位.Value
add_rs!入库数量.Value = !入库数量.Value
add_rs!入库均价.Value = !入库均价.Value
add_rs!入库金额.Value = !入库金额.Value
add_rs!出库数量.Value = !出库数量.Value
add_rs!出库均价.Value = !出库均价.Value
add_rs!出库金额.Value = !出库金额.Value
add_rs!成本均价.Value = !成本均价.Value
add_rs!成本金额.Value = !成本金额.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
Call 导出查询表结果("导出出入库统计查询表")
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
Dim rfdate As Date
Dim rldate As Date
Dim rftext As String
Dim rltext As String
Dim cfdate As Date
Dim cldate As Date
Dim cftext As String
Dim cltext As String
rftext = Nz(DMin("最早入库日期", "入库日期查询"), "")
rltext = Nz(DMax("最后入库日期", "入库日期查询"), "")
cftext = Nz(DMin("最早出库日期", "出库日期查询"), "")
cltext = Nz(DMax("最后出库日期", "出库日期查询"), "")
If (rftext <> "" And rltext <> "") Or (cftext <> "" And cltext <> "") Then
rfdate = CDate(rftext)
rldate = CDate(rltext)
cfdate = CDate(cftext)
cldate = CDate(cltext)
If rfdate < cfdate Then
Me.起始日期 = rfdate
Else
Me.起始日期 = cfdate
End If
If rldate > cldate Then
Me.截止日期 = rldate
Else
Me.截止日期 = cldate
End If
Else
Me.起始日期 = ""
Me.截止日期 = ""
End If
'---------------------------如果日期不为空
If Me.起始日期 <> "" And Me.截止日期 <> "" Then
Call 复制入库单明细表(Me.起始日期, Me.截止日期)
Call 复制出库单明细表(Me.起始日期, Me.截止日期)
Call 货品出入库汇总
Me.数据表子窗体.Requery
End If
End Sub
Sub 复制入库单明细表(ByVal fd As Date, ByVal ld As Date)
On Error GoTo 导出失败
'------------------------------------------------------前期
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 前期入库明细表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 入库单明细查询 Where 出入库日期 <#" & fd & "#"
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("前期入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------期中
DoCmd.SetWarnings (False)
del_sql = "Delete From 期中入库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 入库单明细查询 Where 出入库日期 >=#" & fd & "# and 出入库日期 <=#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("期中入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------后期
DoCmd.SetWarnings (False)
del_sql = "Delete From 后期入库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 入库单明细查询 Where 出入库日期 >#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("后期入库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Sub 复制出库单明细表(ByVal fd As Date, ByVal ld As Date)
On Error GoTo 导出失败
'------------------------------------------------------前期
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 前期出库明细表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 出库单明细查询 Where 出入库日期 <#" & fd & "#"
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("前期出库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------期中
DoCmd.SetWarnings (False)
del_sql = "Delete From 期中出库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 出库单明细查询 Where 出入库日期 >=#" & fd & "# and 出入库日期 <=#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("期中出库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------后期
DoCmd.SetWarnings (False)
del_sql = "Delete From 后期出库明细表"
DoCmd.RunSQL del_sql
dflink_sql = "SELECT * FROM 出库单明细查询 Where 出入库日期 >#" & ld & "#"
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Set add_rs = CurrentDb.OpenRecordset("后期出库明细表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!单价.Value = !单价.Value
add_rs!数量.Value = !数量.Value
add_rs!货品金额.Value = !货品金额.Value
add_rs!出入库日期.Value = !出入库日期.Value
add_rs!凭证单号.Value = !凭证单号.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Sub 货品出入库汇总()
On Error GoTo 导出失败
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 出入库统计表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
dflink_sql = "SELECT * FROM 货品表"
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("出入库统计表", dbOpenTable)
'-------------------------
Dim 入库数量num As Single
Dim 出库数量num As Single
Dim 期初库存num As Single
Dim 期初金额num As Currency
Dim 前期入库数量num As Single
Dim 前期入库金额num As Currency
Dim 期中入库数量num As Single
Dim 期中入库金额num As Currency
Dim 成本均价num As Currency
Do While .EOF = False
入库数量num = Nz(DLookup("期中入库数量", "期中入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
出库数量num = Nz(DLookup("期中出库数量", "期中出库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
期初库存num = Nz(!期初库存.Value, 0)
期初金额num = Nz(!期初金额.Value, 0)
前期入库数量num = Nz(DLookup("前期入库数量", "前期入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
前期入库金额num = Nz(DLookup("前期入库金额", "前期入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
期中入库数量num = 入库数量num
期中入库金额num = Nz(DLookup("期中入库金额", "期中入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
If 期中入库数量num + 前期入库数量num + 期初库存num > 0 Then
成本均价num = (期初金额num + 前期入库金额num + 期中入库金额num) / (期中入库数量num + 前期入库数量num + 期初库存num)
Else
成本均价num = 0 '是0还是出库均价
End If
If 入库数量num <> 0 Or 出库数量num <> 0 Then
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!入库数量.Value = 入库数量num
add_rs!入库均价.Value = Nz(DLookup("期中入库均价", "期中入库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
add_rs!入库金额.Value = 期中入库金额num
add_rs!出库数量.Value = 出库数量num
add_rs!出库均价.Value = Nz(DLookup("期中出库均价", "期中出库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
add_rs!出库金额.Value = Nz(DLookup("期中出库金额", "期中出库统计查询", "货品编号='" & !货品编号.Value & "'"), 0)
add_rs!成本均价.Value = 成本均价num
add_rs!成本金额.Value = 成本均价num * 出库数量num
add_rs.Update
End If
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
'------------------------------------------------------
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub 选择货品_Change()
If Me.选择货品 <> "" Then
Me.数据表子窗体.Form.Filter = "货品编号='" & Me.选择货品 & "'"
Me.数据表子窗体.Form.FilterOn = True
Else
Me.数据表子窗体.Form.FilterOn = False
End If
End Sub
供货单位数据表
Private Sub Form_BeforeUpdate(Cancel As Integer)
If gx_num = 0 Then
Exit Sub
End If
On Error GoTo 数据更新前提醒_Err
If (MsgBox("是否保存对记录的修改", 1, "修改记录提醒") = 1) Then
Beep
' MsgBox "记录修改成功", vbyesOnly, "提醒"
Else
DoCmd.RunCommand acCmdUndo
End If
数据更新前提醒_Exit:
' Exit Function
Exit Sub
数据更新前提醒_Err:
MsgBox Error$
Resume 数据更新前提醒_Exit
End Sub
货品查询
Option Compare Database
Option Explicit
Private Sub Command查询_Click()
On Error GoTo 结束查询
Dim search_field As String
If Me.查询字段 = "日期" Then
If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
hp_filter = search_field & " between #" & Me.起始日期 & "# and #" & Me.截止日期 & "#"
Me.数据表子窗体.Form.Filter = hp_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
hp_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If Me.查询字段 = "入库价" Or Me.查询字段 = "出库价" Or Me.查询字段 = "期初库存" Or Me.查询字段 = "期初金额" Or Me.查询字段 = "最低库存" Or Me.查询字段 = "最高库存" Then
If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
hp_filter = search_field & " >= " & Me.最小 & " And " & search_field & " <= " & Me.最大
Me.数据表子窗体.Form.Filter = hp_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
hp_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
End If
If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then
search_field = Me.查询字段
hp_filter = search_field & " like '*" & Me.查询内容 & "*'"
Me.数据表子窗体.Form.Filter = hp_filter
Me.数据表子窗体.Form.FilterOn = True
Me.数据表子窗体.Requery
Else
hp_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End If
Me.数据表子窗体.SetFocus
Exit Sub
结束查询:
MsgBox Err.Description
End Sub
Private Sub Command全部_Click()
hp_filter = ""
Me.数据表子窗体.Form.FilterOn = False
Me.数据表子窗体.Requery
End Sub
Private Sub Command数据导出_Click()
On Error GoTo 导出失败
'------------------------------------------------清空表数据
DoCmd.SetWarnings (False)
Dim del_sql As String
del_sql = "Delete From 导出货品表"
DoCmd.RunSQL del_sql
Dim dflink_sql As String
hp_filter = Me.数据表子窗体.Form.Filter
If hp_filter <> "" And Me.数据表子窗体.Form.FilterOn = True Then
dflink_sql = "SELECT * FROM 货品表 " & " Where " & hp_filter
Else
dflink_sql = "SELECT * FROM 货品表"
End If
hp_order = Me.数据表子窗体.Form.OrderBy
If hp_order <> "" Then
dflink_sql = dflink_sql & " order by " & hp_order
End If
Dim dflink_rs As DAO.Recordset
Set dflink_rs = CurrentDb.OpenRecordset(dflink_sql, dbOpenDynaset)
With dflink_rs
Dim add_rs As DAO.Recordset
Set add_rs = CurrentDb.OpenRecordset("导出货品表", dbOpenTable)
Do While .EOF = False
add_rs.AddNew
add_rs!货品编号.Value = !货品编号.Value
add_rs!货品名称.Value = !货品名称.Value
add_rs!规格型号.Value = !规格型号.Value
add_rs!单位.Value = !单位.Value
add_rs!入库价.Value = !入库价.Value
add_rs!出库价.Value = !出库价.Value
add_rs!货品类别.Value = !货品类别.Value
add_rs!期初库存.Value = !期初库存.Value
add_rs!期初金额.Value = !期初金额.Value
add_rs!最低库存.Value = !最低库存.Value
add_rs!最高库存.Value = !最高库存.Value
add_rs!备注.Value = !备注.Value
add_rs.Update
.MoveNext
Loop
End With
add_rs.Close
Set add_rs = Nothing
dflink_rs.Close
Set dflink_rs = Nothing
Call 导出查询表结果("导出货品表")
Exit Sub
导出失败:
MsgBox Err.Description
End Sub
Private Sub Command添加_Click()
DoCmd.OpenForm "货品添加", acNormal
End Sub
Private Sub Form_Load()
DoCmd.Restore
hp_type = 0
hp_filter = ""
hp_order = "货品编号 DESC"
Me.数据表子窗体.Form.OrderBy = hp_order
Me.数据表子窗体.Form.OrderByOn = True
Me.查询内容.Visible = True
'-----------------------------隐藏日期控件
Me.起始日期.Visible = False
Me.截止日期.Visible = False
'-----------------------------隐藏金额控件
Me.最小.Visible = False
Me.最大.Visible = False
End Sub
Private Sub 查询字段_Change()
If Me.查询字段 = "日期" Then
Me.起始日期.Visible = True
Me.截止日期.Visible = True
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
If Me.查询字段 = "入库价" Or Me.查询字段 = "出库价" Or Me.查询字段 = "期初库存" Or Me.查询字段 = "期初金额" Or Me.查询字段 = "最低库存" Or Me.查询字段 = "最高库存" Then
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = True
Me.最大.Visible = True
Me.查询内容.Visible = False
Exit Sub
Else
Me.起始日期.Visible = False
Me.截止日期.Visible = False
Me.最小.Visible = False
Me.最大.Visible = False
Me.查询内容.Visible = True
End If
End Sub
