系统日志 Dim SQL As String Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 1000 DataGrid1.Columns(1).width = 1800 DataGrid1.Columns(2).width = 2200 End Sub Private Sub Check1_Click() update End Sub Private Sub Check2_Click() update End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString SQL = Adodc1.RecordSource Set DataGrid1.DataSource = Adodc1 Adodc1.Visible = False Option1.Value = True End Sub Private Sub Option1_Click() update End Sub Private Sub Option2_Click() update End Sub Private Sub Option3_Click() update End Sub Private Sub Option4_Click() update End Sub Private Sub update() On Error GoTo quit Dim s As String s = SQL + " where true" If Check1.Value = 1 And 用户名.Text <> "" Then s = s + " and 用户名 like ';%" + 用户名.Text + "%';" End If If Check2.Value = 1 And 操作内容.Text <> "" Then s = s + " and 操作内容 like ';%" + 操作内容.Text + "%';" End If Dim t As Date t = Date If Option1.Value = True Then ElseIf Option2.Value = True Then t = DateAdd("d", -3, t) ElseIf Option3.Value = True Then t = DateAdd("d", -7, t) End If If Option4.Value = False Then s = s + " and 操作时间>=" + "#" + Str(t) + " 0:0:0#" End If s = s + " order by 操作时间 desc" Adodc1.RecordSource = s Adodc1.Refresh initdatagrid1 quit: End Sub Private Sub 操作内容_Change() Check2.Value = 0 End Sub Private Sub 用户名_Change() Check1.Value = 0 End Sub

新增报损单 Private 客户编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 报损单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,报损单.报损时间,报损单.报损单价,货物信息.计量单位,报损单.报损数量,(报损单.报损单价*报损单.报损数量) as 金额,报损单.其它金额,仓库.仓库名称 as 存放仓库,报损单.备注 from 报损单,货物信息,职员信息,仓库 where 货物信息.编号=报损单.货物编号 and 职员信息.编号=报损单.经办人编号 and 仓库.编号=报损单.仓库编号 and 报损单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("报损单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("报损数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("报损时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写报损单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "报损失败,不能报损" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的报损单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,报损时间,报损单价,报损数量,仓库编号,其它金额,备注 from 报损单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("报损时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("报损单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("报损数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增报损单成功!" ';写入系统日志 fMainForm.WriteLog ("新增报损单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印报损单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择报损货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

新增出库单 Private 客户编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 客户.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 客户.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 出库单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,出库单.出库时间,出库单.出库单价,货物信息.计量单位,出库单.出库数量,(出库单.出库单价*出库单.出库数量) as 金额,出库单.其它金额,客户.客户名称 as 客户,仓库.仓库名称 as 存放仓库,出库单.备注 from 出库单,货物信息,职员信息,客户,仓库 where 货物信息.编号=出库单.货物编号 and 职员信息.编号=出库单.经办人编号 and 客户.编号=出库单.客户编号 and 仓库.编号=出库单.仓库编号 and 出库单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("出库单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("出库数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 客户.Text = fMainForm.m_checkado.Recordset.Fields("客户").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("出库时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写出库单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "出库失败,不能出库" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的出库单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,出库时间,出库单价,出库数量,客户编号,仓库编号,定单状况,其它金额,备注 from 出库单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("出库时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("出库单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("出库数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("客户编号") = 客户编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增出库单成功!" ';写入系统日志 fMainForm.WriteLog ("新增出库单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印出库单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 客户_Click() If 客户.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,客户名称 from 客户" sel.title = "请选择客户" sel.Show vbModal If sel.result1 <> "" Then 客户编号 = sel.result1 If sel.result2 <> "" Then 客户.Text = sel.result2 Unload sel End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择出库货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 客户_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

新增调拔单 Private 原存放仓库编号, 目标存放仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 其它金额.BackColor = bkcolor 目标存放仓库.BackColor = bkcolor 原存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单位.Locked = True 数量.Locked = True 其它金额.Locked = True 原存放仓库.Locked = True 目标存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 调拔单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,调拔单.调拔时间,货物信息.计量单位,调拔单.调拔数量,调拔单.其它金额,仓库.仓库名称 as 原存放仓库,(select 仓库名称 from 仓库 where 编号=调拔单.目标仓库编号) as 目标存放仓库,调拔单.备注 from 调拔单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=调拔单.货物编号 and 职员信息.编号=调拔单.经办人编号 and 仓库.编号=调拔单.原仓库编号 and 调拔单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("调拔数量").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 原存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("原存放仓库").Value 目标存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("目标存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("调拔时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 原存放仓库.Text = "" Then MsgBox "请填写供应商!", vbQuestion: Exit Sub If 目标存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub If 原存放仓库.Text = 目标存放仓库 Then MsgBox "原存放仓库和目标存放仓库不能相同!", vbQuestion: Exit Sub ';检测原仓库********************************************************** On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(原存放仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max1 As String On Error Resume Next max1 = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a1, b1 As Long a1 = 数量.Text: b1 = max1 If a1 > b1 Then MsgBox "调拔失败,不能调拔" + 数量.Text + ",原仓库库存剩余量为" + Str(max1) Exit Sub End If ';检测目标仓库********************************************************** ';得到最高限量max On Error Resume Next Dim max2, use, left As String fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh max2 = fMainForm.m_checkado.Recordset.Fields(0).Value ';得到当前仓库库存量use fMainForm.m_checkado.RecordSource = "select 库存数量 from 货物信息,库存状况 where 货物编号=" + 货物编号 + " and 仓库编号=" + 目标存放仓库编号 fMainForm.m_checkado.Refresh use = 0 On Error GoTo 1: use = fMainForm.m_checkado.Recordset.Fields(0).Value 1: On Error GoTo quit left = max2 - use Dim a2, b2 As Long ';如果超过最高限量 a2 = 数量.Text: b2 = left If a2 > b2 Then MsgBox "调拔失败,不能调拔" + 数量.Text + ",目标仓库剩余限量为" + Str(left) Exit Sub End If ';更新数据库信息********************************************************** ';新增调拔单 (编号,.......) fMainForm.m_checkado.RecordSource = "select * from 调拔单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号").Value = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号").Value = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号").Value = 经办人编号 fMainForm.m_checkado.Recordset.Fields("调拔时间").Value = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("调拔数量").Value = 数量.Text fMainForm.m_checkado.Recordset.Fields("原仓库编号").Value = 原存放仓库编号 fMainForm.m_checkado.Recordset.Fields("目标仓库编号").Value = 目标存放仓库编号 fMainForm.m_checkado.Recordset.Fields("其它金额").Value = 其它金额.Text fMainForm.m_checkado.Recordset.Fields("备注").Value = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';原仓库数量减 数量.text (原存放仓库编号,货物编号) fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(原存放仓库编号) fMainForm.m_checkado.Refresh Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';目标仓库数量加 数量.text (目标存放仓库编号,货物编号) fMainForm.m_checkado.RecordSource = "select * from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(目标存放仓库编号) fMainForm.m_checkado.Refresh ';如果以存在则更新 If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量") = fMainForm.m_checkado.Recordset.Fields("库存数量") + 数量.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh Else ';如果不存在则创建 ';获取新的库存状况的编号 ncode fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh Dim ncode As String If fMainForm.m_checkado.Recordset.RecordCount > 0 Then ';移到最后记录 fMainForm.m_checkado.Recordset.MoveLast ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else ncode = 1 End If ';增加新的库存状况 fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号").Value = ncode fMainForm.m_checkado.Recordset.Fields("货物编号").Value = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("库存数量").Value = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号").Value = 目标存放仓库编号 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增调拔单成功!" ';写入系统日志 fMainForm.WriteLog ("新增调拔单") GoTo quit2 quit: MsgBox "新增调拔单失败!" quit2: End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 目标存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 原存放仓库_Click() If 原存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择原存放仓库" sel.Show vbModal If sel.result1 <> "" Then 原存放仓库编号 = sel.result1 If sel.result2 <> "" Then 原存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 目标存放仓库_Click() If 目标存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,货物信息.最高限量,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量,(货物信息.最高限量-库存量) as 剩余限量 from 仓库,货物信息 where 货物信息.编号=" + 货物编号.Text Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择目标存放仓库" sel.Show vbModal If sel.result1 <> "" Then 目标存放仓库编号 = sel.result1 If sel.result2 <> "" Then 目标存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印调拔单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择调拔货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 原存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

新增借出单 Private 供应商编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 其它金额.BackColor = bkcolor 供应商.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单位.Locked = True 数量.Locked = True 其它金额.Locked = True 供应商.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 借出单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,借出单.借出时间,货物信息.计量单位,借出单.借出数量,借出单.其它金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,借出单.备注 from 借出单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=借出单.货物编号 and 职员信息.编号=借出单.经办人编号 and 供应商.编号=借出单.供应商编号 and 仓库.编号=借出单.仓库编号 and 借出单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("借出数量").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 供应商.Text = fMainForm.m_checkado.Recordset.Fields("供应商").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("借出时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有足够的库存 fMainForm.m_checkado.RecordSource = "select sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量 from 仓库,货物信息 where 仓库.编号=" + Str(仓库编号) + " and 货物信息.编号=" + 货物编号.Text fMainForm.m_checkado.Refresh Dim max As String On Error Resume Next max = fMainForm.m_checkado.Recordset.Fields(0).Value ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = max If a > b Then MsgBox "借出失败,不能借出" + 数量.Text + ",库存剩余量为" + Str(max) Exit Sub End If ';库存量足够 ';开始写出新的借出单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,借出时间,借出数量,供应商编号,仓库编号,定单状况,其它金额,备注 from 借出单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("借出时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("借出数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("供应商编号") = 供应商编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + Str(货物编号) + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then Dim n As Long n = fMainForm.m_checkado.Recordset.Fields("库存数量").Value - 数量.Text If n > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = n fMainForm.m_checkado.Recordset.update Else fMainForm.m_checkado.Recordset.Delete End If fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增借出单成功!" ';写入系统日志 fMainForm.WriteLog ("新增借出单") End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存数量 from 仓库 where 仓库.编号 in (select 仓库编号 from 库存状况 where 货物编号=" + 货物编号 + ")" Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印借出单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 供应商_Click() If 供应商.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,供应商名称 from 供应商" sel.title = "请选择供应商" sel.Show vbModal If sel.result1 <> "" Then 供应商编号 = sel.result1 If sel.result2 <> "" Then 供应商.Text = sel.result2 Unload sel End Sub Private Sub 供应商_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 库存状况.货物编号 as 编号,货物信息.货物名称,库存状况.库存数量,货物信息.最低限量,货物信息.最高限量,仓库.仓库名称 as 存放仓库 from 库存状况,货物信息,仓库 where 货物信息.编号=库存状况.货物编号 and 仓库.编号=库存状况.仓库编号" sel.title = "请选择借出货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

新增借入单 Private 供应商编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 其它金额.BackColor = bkcolor 供应商.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单位.Locked = True 数量.Locked = True 其它金额.Locked = True 供应商.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 借入单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,借入单.借入时间,货物信息.计量单位,借入单.借入数量,借入单.其它金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,借入单.备注 from 借入单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=借入单.货物编号 and 职员信息.编号=借入单.经办人编号 and 供应商.编号=借入单.供应商编号 and 仓库.编号=借入单.仓库编号 and 借入单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("借入数量").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 供应商.Text = fMainForm.m_checkado.Recordset.Fields("供应商").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("借入时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 供应商.Text = "" Then MsgBox "请填写供应商!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有超过库存限量 Dim max, use, left As String ';得到最高限量max fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh max = fMainForm.m_checkado.Recordset.Fields(0).Value ';得到当前仓库库存量use fMainForm.m_checkado.RecordSource = "select 库存数量 from 货物信息,库存状况 where 货物编号=" + 货物编号 + " and 仓库编号=" + 仓库编号 fMainForm.m_checkado.Refresh use = 0 On Error GoTo 1 use = fMainForm.m_checkado.Recordset.Fields(0).Value 1: On Error GoTo quit left = max - use ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = left If a > b Then MsgBox "借入失败,不能借入" + 数量.Text + ",剩余限量为" + Str(left) Exit Sub End If ';库存量足够 ';开始写入新的借入单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,借入时间,借入数量,供应商编号,仓库编号,定单状况,其它金额,备注 from 借入单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("借入时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("借入数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("供应商编号") = 供应商编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh ';如果已有记录 If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + 数量.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh Else ';获取新的库存状况的编号 ncode fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh Dim ncode As String If fMainForm.m_checkado.Recordset.RecordCount > 0 Then ';移到最后记录 fMainForm.m_checkado.Recordset.MoveLast ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else ncode = 1 End If fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = ncode fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号 fMainForm.m_checkado.Recordset.Fields("库存数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增借入单成功!" ';写入系统日志 fMainForm.WriteLog ("新增借入单") GoTo quit2 quit: MsgBox "新增借入单失败!" quit2: End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,货物信息.最高限量,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量,(货物信息.最高限量-库存量) as 剩余限量 from 仓库,货物信息 where 货物信息.编号=" + 货物编号.Text Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 700 PrintForm Me.Height = Me.Height + 700 ';写入系统日志 fMainForm.WriteLog ("打印借入单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 供应商_Click() If 供应商.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,供应商名称 from 供应商" sel.title = "请选择供应商" sel.Show vbModal If sel.result1 <> "" Then 供应商编号 = sel.result1 If sel.result2 <> "" Then 供应商.Text = sel.result2 Unload sel End Sub Private Sub 供应商_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物名称,货物类别,货物规格 from 货物信息" sel.title = "请选择借入货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

新增入库单 Private 供应商编号 As String Private 仓库编号 As String Private 经办人编号 As String Private bkcolor As Long Option Explicit Private Sub ChangeBackColor(bkcolor As Long) Me.BackColor = bkcolor 保存.BackColor = bkcolor 打印.BackColor = bkcolor 更改背景.BackColor = bkcolor 编号.BackColor = bkcolor 货物编号.BackColor = bkcolor 年.BackColor = bkcolor 月.BackColor = bkcolor 日.BackColor = bkcolor 货名规格.BackColor = bkcolor 单价.BackColor = bkcolor 单位.BackColor = bkcolor 数量.BackColor = bkcolor 金额.BackColor = bkcolor 其它金额.BackColor = bkcolor 供应商.BackColor = bkcolor 存放仓库.BackColor = bkcolor 备注.BackColor = bkcolor 经办人.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 年.Locked = True: 月.Locked = True: 日.Locked = True 货物编号.Locked = True 货名规格.Locked = True 单价.Locked = True 单位.Locked = True 数量.Locked = True 金额.Locked = True 其它金额.Locked = True 供应商.Locked = True 存放仓库.Locked = True 备注.Locked = True 经办人.Locked = True End Sub Private Sub Form_Load() bkcolor = RGB(128, 255, 255) End Sub Private Sub Form_Resize() On Error Resume Next ';新增状态 If 编号 = "" Then ';初始化年月日 年.Text = Year(Date) 月.Text = Month(Date) 日.Text = Day(Date) ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 入库单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印状态 fMainForm.m_checkado.RecordSource = "select 货物信息.编号,货物信息.货物名称,货物信息.货物规格,职员信息.姓名 as 经办人,入库单.入库时间,入库单.入库单价,货物信息.计量单位,入库单.入库数量,(入库单.入库单价*入库单.入库数量) as 金额,入库单.其它金额,供应商.供应商名称 as 供应商,仓库.仓库名称 as 存放仓库,入库单.备注 from 入库单,货物信息,职员信息,供应商,仓库 where 货物信息.编号=入库单.货物编号 and 职员信息.编号=入库单.经办人编号 and 供应商.编号=入库单.供应商编号 and 仓库.编号=入库单.仓库编号 and 入库单.编号=" + 编号 fMainForm.m_checkado.Refresh 货物编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value 单价.Text = fMainForm.m_checkado.Recordset.Fields("入库单价").Value 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value 数量.Text = fMainForm.m_checkado.Recordset.Fields("入库数量").Value 金额.Text = fMainForm.m_checkado.Recordset.Fields("金额").Value 其它金额.Text = fMainForm.m_checkado.Recordset.Fields("其它金额").Value 供应商.Text = fMainForm.m_checkado.Recordset.Fields("供应商").Value 存放仓库.Text = fMainForm.m_checkado.Recordset.Fields("存放仓库").Value 备注.Text = fMainForm.m_checkado.Recordset.Fields("备注").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value Dim t As Date t = fMainForm.m_checkado.Recordset.Fields("入库时间").Value 年.Text = Year(t) 月.Text = Month(t) 日.Text = Day(t) ';锁住控件 lockcontrol 打印.Visible = True 保存.Visible = False 更改背景.Visible = True End If End Sub Private Sub 保存_Click() If 年.Text = "" Or 月.Text = "" Or 日.Text = "" Then MsgBox "请填写日期!", vbQuestion: Exit Sub If 货物编号.Text = "" Then MsgBox "请填写货物信息!", vbQuestion: Exit Sub If 单价.Text = "" Then MsgBox "请填写入库单价!", vbQuestion: Exit Sub If 数量.Text = "" Then MsgBox "请填数量!", vbQuestion: Exit Sub If 供应商.Text = "" Then MsgBox "请填写供应商!", vbQuestion: Exit Sub If 存放仓库.Text = "" Then MsgBox "请填写存放仓库!", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人!", vbQuestion: Exit Sub On Error Resume Next ';检测有没有超过库存限量 Dim max, use, left As String ';得到最高限量max fMainForm.m_checkado.RecordSource = "select 最高限量 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh max = fMainForm.m_checkado.Recordset.Fields(0).Value ';得到当前仓库库存量use fMainForm.m_checkado.RecordSource = "select 库存数量 from 货物信息,库存状况 where 货物编号=" + 货物编号 + " and 仓库编号=" + 仓库编号 fMainForm.m_checkado.Refresh use = 0 On Error GoTo 1: use = fMainForm.m_checkado.Recordset.Fields(0).Value 1: On Error GoTo quit left = max - use ';如果超过最高限量 Dim a, b As Long a = 数量.Text: b = left If a > b Then MsgBox "入库失败,不能入库" + 数量.Text + ",剩余限量为" + Str(left) Exit Sub End If ';库存量足够 ';开始写入新的入库单到数据库 On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,经办人编号,入库时间,入库单价,入库数量,供应商编号,仓库编号,定单状况,其它金额,备注 from 入库单" fMainForm.m_checkado.Refresh fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = 编号.Text fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("经办人编号") = 经办人编号 fMainForm.m_checkado.Recordset.Fields("入库时间") = 年.Text + "-" + 月.Text + "-" + 日.Text fMainForm.m_checkado.Recordset.Fields("入库单价") = 单价.Text fMainForm.m_checkado.Recordset.Fields("入库数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("供应商编号") = 供应商编号 fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.Fields("定单状况") = "已处理" fMainForm.m_checkado.Recordset.Fields("其它金额") = 其它金额 fMainForm.m_checkado.Recordset.Fields("备注") = 备注.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh ';更新[库存状况] On Error Resume Next fMainForm.m_checkado.RecordSource = "select 编号,货物编号,库存数量,仓库编号 from 库存状况 where 货物编号=" + 货物编号.Text + " and 仓库编号=" + Str(仓库编号) fMainForm.m_checkado.Refresh ';如果已有记录 If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.Fields("库存数量").Value = fMainForm.m_checkado.Recordset.Fields("库存数量").Value + 数量.Text fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh Else ';获取新的库存状况的编号 ncode fMainForm.m_checkado.RecordSource = "select * from 库存状况" fMainForm.m_checkado.Refresh Dim ncode As String If fMainForm.m_checkado.Recordset.RecordCount > 0 Then ';移到最后记录 fMainForm.m_checkado.Recordset.MoveLast ncode = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else ncode = 1 End If fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号") = ncode fMainForm.m_checkado.Recordset.Fields("货物编号") = 货物编号.Text fMainForm.m_checkado.Recordset.Fields("库存数量") = 数量.Text fMainForm.m_checkado.Recordset.Fields("仓库编号") = 仓库编号 fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh End If 保存.Visible = False 更改背景.Visible = True 打印.Visible = True ';锁住控件 lockcontrol MsgBox "新增入库单成功!" ';写入系统日志 fMainForm.WriteLog ("新增入库单") GoTo quit2 quit: MsgBox "新增入库单失败!" quit2: End Sub Private Sub 存放仓库_Click() If 存放仓库.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString If 货物编号.Text <> "" Then sel.Adodc1.RecordSource = "select 仓库.编号,仓库.仓库名称,货物信息.最高限量,sum(select 库存数量 from 库存状况 where 仓库编号=仓库.编号 and 货物编号=" + 货物编号.Text + ") as 库存量,(货物信息.最高限量-库存量) as 剩余限量 from 仓库,货物信息 where 货物信息.编号=" + 货物编号.Text Else sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" End If sel.title = "请选择存放仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 存放仓库.Text = sel.result2 Unload sel End Sub Private Sub 存放仓库_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印_Click() Me.Height = Me.Height - 600 PrintForm Me.Height = Me.Height + 600 ';写入系统日志 fMainForm.WriteLog ("打印入库单") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With ChangeBackColor (CommonDialog1.Color) End Sub Private Sub 供应商_Click() If 供应商.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,供应商名称 from 供应商" sel.title = "请选择供应商" sel.Show vbModal If sel.result1 <> "" Then 供应商编号 = sel.result1 If sel.result2 <> "" Then 供应商.Text = sel.result2 Unload sel End Sub Private Sub 供应商_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 货物编号_Click() If 货物编号.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,货物名称,货物类别,货物规格 from 货物信息" sel.title = "请选择入库货物" sel.Show vbModal If sel.result1 <> "" Then 货物编号.Text = sel.result1 Else Exit Sub Unload sel End If Unload sel ';更新货名规格与计量单位 fMainForm.m_checkado.RecordSource = "select 货物名称,货物规格,计量单位 from 货物信息 where 编号=" + 货物编号.Text fMainForm.m_checkado.Refresh 货名规格.Text = fMainForm.m_checkado.Recordset.Fields("货物名称").Value On Error GoTo cont Dim s As String s = fMainForm.m_checkado.Recordset.Fields("货物规格").Value If Len(s) > 0 Then 货名规格.Text = 货名规格.Text + "(" + s + ")" cont: On Error Resume Next 单位.Text = fMainForm.m_checkado.Recordset.Fields("计量单位").Value End Sub Private Sub 货物编号_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 金额_Click() If 金额.Locked Then Exit Sub On Error Resume Next 金额.Text = 单价.Text * 数量.Text End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

用户管理 Private m_IsAdd As Boolean Private Function ModifyPurview(ByVal d As Long) Dim f As New 权限选择 f.Purview = d If Adodc1.Recordset.Fields("用户名").Value = UserName Then f.Check(16).Enabled = False f.Show vbModal ModifyPurview = f.Purview Unload f End Function Private Sub initdatagrid1() DataGrid1.Columns(0).width = 2000 DataGrid1.Columns(1).width = 1800 DataGrid1.Columns(2).width = 0 DataGrid1.Columns(0).AllowSizing = False DataGrid1.Columns(1).AllowSizing = False DataGrid1.Columns(2).AllowSizing = False DataGrid1.AllowRowSizing = False DataGrid1.Columns(0).Locked = True DataGrid1.Columns(2).Locked = True End Sub Private Sub Form_Load() ';初始化数据源 Adodc1.ConnectionString = DataConnectString Set DataGrid1.DataSource = Adodc1 Adodc1.Refresh Adodc1.Visible = False initdatagrid1 End Sub Private Sub DataGrid1_OnAddNew() DataGrid1.Columns(0).Locked = False DataGrid1.Columns(2).Value = 0 m_IsAdd = True End Sub Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer) If m_IsAdd = False Then DataGrid1.Columns(0).Locked = True Else m_IsAdd = False End If End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ';写入系统日志 fMainForm.WriteLog ("查看或修改用户管理") End Sub Private Sub Form_Unload(Cancel As Integer) ';检测当前用户名密码是否改变，如果改变则重置它 Dim fit As String ';查找用户名 fit = "用户名=';" fit = fit + UserName + "';" Adodc1.Recordset.Find fit Adodc1.Recordset.MoveFirst Adodc1.Recordset.Find fit ';找不到该用户 On Error GoTo reset If Adodc1.Recordset.EOF <> True Then UserPas = Adodc1.Recordset.Fields("用户密码").Value GoTo quit reset: UserPas = "" quit: End Sub Private Sub 删除用户_Click() On Error Resume Next If Adodc1.Recordset.Fields("用户名").Value = UserName Then MsgBox "不能删除当前登陆用户!": Exit Sub Adodc1.Recordset.Delete Adodc1.Recordset.Requery initdatagrid1 End Sub Private Sub 修改权限_Click() On Error Resume Next Dim l1, l2 As Long On Error GoTo 1 l1 = Adodc1.Recordset.Fields("用户权限").Value GoTo 2 1: l1 = 0 2: l2 = ModifyPurview(l1) If l2 <> l1 Then Adodc1.Recordset.Fields("用户权限").Value = l2 Adodc1.Recordset.update Adodc1.Recordset.Requery initdatagrid1 End If End Sub

月盘点 Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long Private 仓库编号 As String Private 经办人编号 As String Private m_data(5, 4) As String Private m_otherdata(5) As String Option Explicit Private Sub printdata(i, j) Dim X, Y As Long X = col(j).left / 15 + 5 Y = row(i).Top / 15 TextOut Me.hdc, X, Y, m_data(i, j), Len(m_data(i, j)) End Sub Private Sub printotherdata(i) Dim X, Y As Long If i = 0 Then X = (other1.left + other1.width) / 15 + 5 Y = other1.Top / 15 ElseIf i = 1 Then X = (other2.left + other2.width) / 15 + 5 Y = other2.Top / 15 ElseIf i = 2 Then X = (other3.left + other3.width) / 15 + 5 Y = other3.Top / 15 ElseIf i = 3 Then X = (other4.left + other4.width) / 15 + 5 Y = other4.Top / 15 ElseIf i = 4 Then X = (other5.left + other5.width) / 15 + 5 Y = other5.Top / 15 Else X = (other6.left + other6.width) / 15 + 5 Y = other6.Top / 15 End If TextOut Me.hdc, X, Y, m_otherdata(i), Len(m_otherdata(i)) End Sub Private Sub printalldata() Dim i, j As Integer For i = 0 To 5 For j = 0 To 4 printdata i, j Next j Next i For i = 0 To 5 printotherdata i Next i End Sub Private Function GetMinDate() Dim t As Date t = Date t = DateAdd("m", -1, t) GetMinDate = Str(t) End Function Private Sub ChangeBackColor() Dim bkcolor As Long bkcolor = Me.BackColor 编号.BackColor = bkcolor 日期.BackColor = bkcolor 经办人.BackColor = bkcolor 仓库名称.BackColor = bkcolor 进行月盘点.BackColor = bkcolor 更改背景.BackColor = bkcolor 打印月盘点单.BackColor = bkcolor 保存月盘点.BackColor = bkcolor End Sub Private Sub lockcontrol() 编号.Locked = True 仓库名称.Locked = True 经办人.Locked = True End Sub Private Sub Form_Paint() printalldata End Sub Private Sub Form_Resize() ChangeBackColor ';新增盘点单 If 编号.Text = "" Then 日期.Text = Date 打印月盘点单.Visible = False 更改背景.Visible = False ';初始化编号 fMainForm.m_checkado.RecordSource = "select 编号 from 盘点单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast 编号.Text = fMainForm.m_checkado.Recordset.Fields("编号").Value + 1 Else 编号.Text = 1 End If Else ';打印盘点单 ';初始化数据 fMainForm.m_checkado.RecordSource = "select 仓库.仓库名称,职员信息.姓名 as 经办人,盘点单.盘点数据,盘点单.盘点时间 from 仓库,职员信息,盘点单 where 仓库.编号=盘点单.仓库编号 and 职员信息.编号=盘点单.经办人编号 and 盘点单.编号=" + 编号.Text + " and 盘点时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then 仓库名称.Text = fMainForm.m_checkado.Recordset.Fields("仓库名称").Value 经办人.Text = fMainForm.m_checkado.Recordset.Fields("经办人").Value 日期.Text = fMainForm.m_checkado.Recordset.Fields("盘点时间").Value Dim data As String data = fMainForm.m_checkado.Recordset.Fields("盘点数据").Value Dim i, j, n As Long i = 1: n = 1 j = InStr(i, data, ";") While (j <> 0) If n <= 30 Then m_data(n / 5, (n - 1) Mod 5) = Mid(data, i, j - i) Else m_otherdata(n - 31) = Mid(data, i, j - i) End If On Error Resume Next n = n + 1 i = j + 1 j = InStr(i, data, ";") Wend End If 进行月盘点.Visible = False lockcontrol End If End Sub Private Sub 保存月盘点_Click() On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 盘点单" fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then fMainForm.m_checkado.Recordset.MoveLast End If fMainForm.m_checkado.Recordset.AddNew fMainForm.m_checkado.Recordset.Fields("编号").Value = 编号.Text fMainForm.m_checkado.Recordset.Fields("仓库编号").Value = 仓库编号 fMainForm.m_checkado.Recordset.Fields("盘点时间").Value = 日期.Text fMainForm.m_checkado.Recordset.Fields("经办人编号").Value = 经办人编号 Dim data As String Dim i, j As Integer data = "" For j = 0 To 5 For i = 0 To 4 data = data + m_data(j, i) + ";" Next i Next j For i = 0 To 5 data = data + m_otherdata(i) + ";" Next i fMainForm.m_checkado.Recordset.Fields("盘点数据").Value = data fMainForm.m_checkado.Recordset.update fMainForm.m_checkado.Refresh MsgBox "月盘点单保存成功!" ';写入系统日志 fMainForm.WriteLog ("新增月盘点") 保存月盘点.Visible = False 更改背景.Visible = True 打印月盘点单.Visible = True End Sub Private Sub 仓库名称_Click() If 仓库名称.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,仓库名称 from 仓库" sel.title = "请选择盘点仓库" sel.Show vbModal If sel.result1 <> "" Then 仓库编号 = sel.result1 If sel.result2 <> "" Then 仓库名称.Text = sel.result2 Unload sel End Sub Private Sub 仓库名称_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub Private Sub 打印月盘点单_Click() Me.Height = Me.Height - 700 PrintForm Me.Height = Me.Height + 700 ';写入系统日志 fMainForm.WriteLog ("打印月盘点") End Sub Private Sub 更改背景_Click() On Error Resume Next With CommonDialog1 .DialogTitle = "页面设置" .CancelError = True .ShowColor End With Me.BackColor = CommonDialog1.Color ChangeBackColor End Sub Private Sub 进行月盘点_Click() If 仓库名称.Text = "" Then MsgBox "请填写仓库名称", vbQuestion: Exit Sub If 经办人.Text = "" Then MsgBox "请填写经办人", vbQuestion: Exit Sub On Error Resume Next fMainForm.m_checkado.RecordSource = "select * from 盘点单 where 仓库编号=" + 仓库编号 + " and 盘点时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then MsgBox "该仓库本月已盘点!" Exit Sub End If ';进行数据处理 ';入库单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(入库数量) as 入库总量,sum(入库单价*入库数量) as 总金额 from 入库单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 入库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(0, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(0, 2) = fMainForm.m_checkado.Recordset.Fields("入库总量").Value m_data(0, 4) = fMainForm.m_checkado.Recordset.Fields("总金额").Value End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 入库单 where 仓库编号=" + 仓库编号 + " and 入库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(0, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(0, 1) = Str(CLng(Val(m_data(0, 1)) - Val(m_data(0, 0)))) m_data(0, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';出库单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(出库数量) as 出库总量,sum(出库单价*出库数量) as 总金额 from 出库单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 出库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(1, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(1, 2) = fMainForm.m_checkado.Recordset.Fields("出库总量").Value m_data(1, 4) = fMainForm.m_checkado.Recordset.Fields("总金额").Value End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 出库单 where 仓库编号=" + 仓库编号 + " and 出库时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(1, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(1, 1) = Str(CLng(Val(m_data(1, 1)) - Val(m_data(1, 0)))) m_data(1, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';借入单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(借入数量) as 借入总量 from 借入单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 借入时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(2, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(2, 2) = fMainForm.m_checkado.Recordset.Fields("借入总量").Value m_data(2, 4) = "" End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 借入单 where 仓库编号=" + 仓库编号 + " and 借入时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(2, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(2, 1) = Str(CLng(Val(m_data(2, 1)) - Val(m_data(2, 0)))) m_data(2, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';借出单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(借出数量) as 借出总量 from 借出单 where 定单状况=';已处理'; and 仓库编号=" + 仓库编号 + " and 借出时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(3, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(3, 2) = fMainForm.m_checkado.Recordset.Fields("借出总量").Value m_data(3, 4) = "" End If fMainForm.m_checkado.RecordSource = "select count(*) as 定单总数,sum(其它金额) as 其它总金额 from 借出单 where 仓库编号=" + 仓库编号 + " and 借出时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(3, 1) = fMainForm.m_checkado.Recordset.Fields("定单总数").Value m_data(3, 1) = Str(CLng(Val(m_data(3, 1)) - Val(m_data(3, 0)))) m_data(3, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';调拔单 原仓库 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(调拔数量) as 调拔总量 from 调拔单 where 原仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(4, 2) = fMainForm.m_checkado.Recordset.Fields("调拔总量").Value m_data(4, 4) = "" End If fMainForm.m_checkado.RecordSource = "select sum(其它金额) as 其它总金额 from 调拔单 where 原仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 1) = "" m_data(4, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';调拔单 目标仓库 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(调拔数量) as 调拔总量 from 调拔单 where 目标仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 0) = LTrim$(Str(CLng(Val(m_data(4, 0)) + Val(fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value)))) m_data(4, 2) = Str(CLng(Val(m_data(4, 2)) - Val(fMainForm.m_checkado.Recordset.Fields("调拔总量").Value))) m_data(4, 4) = "" End If fMainForm.m_checkado.RecordSource = "select sum(其它金额) as 其它总金额 from 调拔单 where 目标仓库编号=" + 仓库编号 + " and 调拔时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(4, 1) = "" m_data(4, 3) = Str(CLng(Val(m_data(4, 3)) + Val(fMainForm.m_checkado.Recordset.Fields("其它总金额").Value))) End If ';报损单 fMainForm.m_checkado.RecordSource = "select count(*) as 已处理定单数,sum(报损数量) as 报损总量,sum(报损单价*报损数量) as 总金额 from 报损单 where 仓库编号=" + 仓库编号 + " and 报损时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(5, 0) = fMainForm.m_checkado.Recordset.Fields("已处理定单数").Value m_data(5, 2) = fMainForm.m_checkado.Recordset.Fields("报损总量").Value m_data(5, 4) = fMainForm.m_checkado.Recordset.Fields("总金额").Value End If fMainForm.m_checkado.RecordSource = "select sum(其它金额) as 其它总金额 from 报损单 where 仓库编号=" + 仓库编号 + " and 报损时间>" + GetMinDate fMainForm.m_checkado.Refresh If fMainForm.m_checkado.Recordset.RecordCount > 0 Then On Error Resume Next m_data(5, 1) = "" m_data(5, 3) = fMainForm.m_checkado.Recordset.Fields("其它总金额").Value End If ';其它总计 ';流入，流出总量 On Error Resume Next m_otherdata(0) = Str(CLng(Val(m_data(0, 2)) + Val(m_data(2, 2)))) m_otherdata(3) = Str(CLng(Val(m_data(1, 2)) + Val(m_data(3, 2)))) ';调拔数量为正 On Error Resume Next If m_data(4, 2) > 0 Then m_otherdata(0) = Str(CLng(Val(m_otherdata(0)) + Val(m_data(4, 2)))) Else m_otherdata(3) = Str(CLng(Val(m_otherdata(3)) + Val(m_data(4, 2)))) End If ';流入，流出金额 On Error Resume Next m_otherdata(1) = Str(Val(m_data(0, 3)) + Val(m_data(1, 3)) + Val(m_data(2, 3)) + Val(m_data(3, 3)) + Val(m_data(4, 3)) + Val(m_data(0, 4)) + Val(m_data(5, 4))) m_otherdata(4) = m_data(1, 4) ';平均单价 On Error Resume Next m_otherdata(2) = Str(CLng((Val(m_otherdata(1)) / Val(m_otherdata(0))) * 100) / 100) m_otherdata(5) = Str(CLng((Val(m_otherdata(4)) / Val(m_otherdata(3))) * 100) / 100) ';数据处理完毕 printalldata 进行月盘点.Visible = False 保存月盘点.Visible = True 仓库名称.Locked = True 经办人.Locked = True End Sub Private Sub 经办人_Click() If 经办人.Locked Then Exit Sub On Error Resume Next Dim sel As New 数据选择 sel.Adodc1.ConnectionString = DataConnectString sel.Adodc1.RecordSource = "select 编号,姓名 from 职员信息" sel.title = "请选择经办人" sel.Show vbModal If sel.result1 <> "" Then 经办人编号 = sel.result1 If sel.result2 <> "" Then 经办人.Text = sel.result2 Unload sel End Sub Private Sub 经办人_KeyPress(KeyAscii As Integer) KeyAscii = 0 End Sub

职员操作统计 Private SQL As String Private startcol As Integer Private endcol As Integer Private col, row As Integer Private rowheight As Integer Private colwidth(8) As Long Private order(8) As Boolean Option Explicit Private Sub initdatagrid1() DataGrid1.Columns(0).width = 500 DataGrid1.Columns(1).width = 1600 DataGrid1.Columns(2).width = 800 DataGrid1.Columns(3).width = 800 DataGrid1.Columns(4).width = 800 DataGrid1.Columns(5).width = 800 DataGrid1.Columns(6).width = 800 DataGrid1.Columns(7).width = 800 DataGrid1.Columns(8).width = 800 DataGrid1.rowheight = 270 End Sub Private Sub SaveInit() startcol = DataGrid1.SelStartCol endcol = DataGrid1.SelEndCol col = DataGrid1.LeftCol row = DataGrid1.row rowheight = DataGrid1.rowheight Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 colwidth(i) = DataGrid1.Columns(i).width Next End Sub Private Sub ResumeInit() DataGrid1.SelStartCol = startcol DataGrid1.SelEndCol = endcol DataGrid1.Scroll col, row DataGrid1.rowheight = rowheight Dim i As Integer For i = 0 To DataGrid1.Columns.count - 1 DataGrid1.Columns(i).width = colwidth(i) Next End Sub Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer) If ColIndex > 1 Then Exit Sub On Error Resume Next Dim caption As String caption = DataGrid1.Columns(ColIndex).caption Adodc1.RecordSource = SQL + " order by " + caption order(ColIndex) = True - order(ColIndex) If order(ColIndex) = True Then Adodc1.RecordSource = Adodc1.RecordSource + " ASC" Else Adodc1.RecordSource = Adodc1.RecordSource + " DESC" End If SaveInit Adodc1.Refresh ResumeInit End Sub Private Sub Form_Load() Adodc1.ConnectionString = DataConnectString Adodc1.Visible = False Adodc2.ConnectionString = DataConnectString Set DataCombo1.RowSource = Adodc2 DataCombo1.ListField = "仓库名称" Adodc2.Refresh Adodc2.Visible = False T出入时间.Text = "无限制" 进行统计_Click End Sub Private Sub Form_Unload(Cancel As Integer) SQL = "" End Sub Private Sub 打印_Click() ShowPrintDlg Adodc1, "职员操作统计" End Sub Private Sub 进行统计_Click() If 限定仓库.Value = 1 And DataCombo1.Text = "" Then MsgBox "请选择仓库名称!": Exit Sub Dim 仓库编号 As Long 仓库编号 = -1 On Error Resume Next If 限定仓库.Value = 1 And DataCombo1.Text <> "" Then ';初始化仓库编号 fMainForm.m_checkado.RecordSource = "select * from 仓库 where 仓库名称=';" + DataCombo1.Text + "';" fMainForm.m_checkado.Refresh 仓库编号 = fMainForm.m_checkado.Recordset.Fields("编号").Value End If On Error Resume Next Dim t As String t = Str(出入时间.Year) + "-" + Str(出入时间.Month) + "-" + Str(出入时间.Day) Dim s As String s = "select 编号,姓名," ';入库单 s = s + "(select count(编号) from 入库单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 入库时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 入库次数," ';出库单 s = s + "(select count(编号) from 出库单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 出库时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 出库次数," ';借入单 s = s + "(select count(编号) from 借入单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 借入时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 借入次数," ';借出单 s = s + "(select count(编号) from 借出单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 借出时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 借出次数," ';调拔单 s = s + "(select count(编号) from 调拔单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 调拔时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 原仓库编号=" + Str(仓库编号) End If s = s + ") as 调拔次数," ';报损单 s = s + "(select count(编号) from 报损单 where 经办人编号=职员信息.编号" If T出入时间.Text <> "无限制" Then s = s + " and 报损时间" + T出入时间.Text + "#" + t + "#" End If If 仓库编号 <> -1 Then s = s + " and 仓库编号=" + Str(仓库编号) End If s = s + ") as 报损次数," ';总次数 s = s + "(入库次数+出库次数+借入次数+借出次数+调拔次数+报损次数) as 总次数" s = s + " from 职员信息" Adodc1.RecordSource = s SaveInit Set DataGrid1.DataSource = Adodc1 ';第一次刷新调用initdatagrid1初始化眉头 If SQL = "" Then Adodc1.Refresh initdatagrid1 Else Adodc1.Refresh ResumeInit End If SQL = s If 零次数.Value = 1 Then Adodc1.Recordset.Filter = "总次数<>0" Else Adodc1.Recordset.Filter = 0 End If End Sub Private Sub 零次数_Click() If 零次数.Value = 1 Then Adodc1.Recordset.Filter = "总次数<>0" Else SaveInit Adodc1.Refresh ResumeInit Adodc1.Recordset.Filter = 0 End If End Sub Private Sub 限定仓库_Click() If 限定仓库.Value = 0 Then DataCombo1.Text = "" End Sub

职员信息

Private m_IsAdd As Boolean
Private SQL As String
Private startcol As Integer
Private endcol As Integer
Private col, row As Integer
Private rowheight As Integer
Private colwidth(14) As Long
Private order(14) As Boolean

Option Explicit
Private Sub initdatagrid1()
    DataGrid1.Columns(0).Locked = True ';编号
    DataGrid1.Columns(0).width = 500
    DataGrid1.Columns(1).width = 800
    DataGrid1.Columns(2).width = 500
    DataGrid1.Columns(3).width = 800
    DataGrid1.Columns(4).width = 900
    DataGrid1.Columns(5).width = 800
    DataGrid1.Columns(6).width = 1000
    DataGrid1.Columns(7).width = 800
    DataGrid1.Columns(8).width = 800
   
    DataGrid1.rowheight = 270
End Sub

Private Sub SaveInit()
   
    startcol = DataGrid1.SelStartCol
    endcol = DataGrid1.SelEndCol
    col = DataGrid1.LeftCol
    row = DataGrid1.row
   
    rowheight = DataGrid1.rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
        colwidth(i) = DataGrid1.Columns(i).width
    Next
   
End Sub
Private Sub ResumeInit()
   
    DataGrid1.SelStartCol = startcol
    DataGrid1.SelEndCol = endcol
    DataGrid1.Scroll col, row
   
    DataGrid1.rowheight = rowheight
   
    Dim i As Integer
    For i = 0 To DataGrid1.Columns.count - 1
         DataGrid1.Columns(i).width = colwidth(i)
    Next
   
End Sub

Private Sub DataGrid1_AfterDelete()
    ';写入系统日志
    fMainForm.WriteLog ("删除职员")
End Sub
Private Sub DataGrid1_AfterInsert()
    ';写入系统日志
    fMainForm.WriteLog ("新增职员")
End Sub
Private Sub DataGrid1_AfterUpdate()
    ';写入系统日志
    fMainForm.WriteLog ("更新职员")
End Sub
Private Sub DataGrid1_BeforeDelete(Cancel As Integer)
   
    On Error Resume Next
    ';判断是否其它表单用了待删除的职员编号
    Dim code As String
    Dim rs As String
    code = DataGrid1.Columns(0).Text
   
    rs = ""
    rs = rs + "select 经办人编号 from 入库单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 出库单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 借入单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 借出单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 调拔单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 经办人编号 from 报损单 where 经办人编号=" + Str(code): rs = rs + " union "
    rs = rs + "select 保管员编号 from 仓库 where 保管员编号=" + Str(code)
    fMainForm.m_checkado.RecordSource = rs
    fMainForm.m_checkado.Refresh
    If fMainForm.m_checkado.Recordset.RecordCount > 0 Then
        MsgBox "其它表单用了此职员信息,不能删除!", vbExclamation
        Cancel = True
    End If
   
End Sub
Private Sub DataGrid1_HeadClick(ByVal ColIndex As Integer)
   
    On Error Resume Next
    Dim caption As String
    caption = DataGrid1.Columns(ColIndex).caption
   
    Adodc1.RecordSource = SQL + " order by " + caption
   
    order(ColIndex) = True - order(ColIndex)
   
    If order(ColIndex) = True Then
        Adodc1.RecordSource = Adodc1.RecordSource + " ASC"
    Else
        Adodc1.RecordSource = Adodc1.RecordSource + " DESC"
    End If
   
    SaveInit
    Adodc1.Refresh
    ResumeInit
   
End Sub
Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    SQL = Adodc1.RecordSource
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
    Adodc1.Visible = False
   
    initdatagrid1
End Sub
Private Sub DataGrid1_OnAddNew()
    DataGrid1.Columns(0).Locked = False
    m_IsAdd = True
   
End Sub

Private Sub DataGrid1_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
   
    If m_IsAdd = False Then
        DataGrid1.Columns(0).Locked = True
    Else
        m_IsAdd = False
    End If
   
End Sub

自定义查询管理
Option Explicit

Private Sub Form_Load()
    Adodc1.ConnectionString = DataConnectString
    Adodc1.Visible = False
   
End Sub
Private Sub Form_Resize()
    Set DataGrid1.DataSource = Adodc1
    Adodc1.Refresh
    DataGrid1.Columns(1).width = 0
   
End Sub
Private Sub 删除自定义查询_Click()
    Adodc1.Recordset.Delete
    DataGrid1.Columns(1).width = 0
   
    ';写入系统日志
    fMainForm.WriteLog ("删除自定义查询")
   
End Sub
Private Sub 增加自定义查询_Click()
   
    If 查询名称.Text = "" Then MsgBox "请填写查询名称!": Exit Sub
    If SQL.Text = "" Then MsgBox "请填写查询SQL语句!": Exit Sub
   
    On Error Resume Next
    If Adodc1.Recordset.RecordCount >= 8 Then
        MsgBox "最多只允许8组自定义查询!"
        Exit Sub
    End If
   
    Adodc1.Recordset.AddNew
    Adodc1.Recordset.Fields("查询名称").Value = 查询名称.Text
    Adodc1.Recordset.Fields("SQL语句").Value = SQL.Text
    Adodc1.Recordset.update
    Adodc1.Recordset.Requery
    Adodc1.Refresh
   
    DataGrid1.Columns(1).width = 0
   
    ';写入系统日志
    fMainForm.WriteLog ("新增自定义查询")
   
End Sub

[这个贴子最后由漫天樱舞在 2005/05/15 10:01pm 第 1 次编辑] 模块 base.bas Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Public Declare Function BackupData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long Public Declare Function ResumeData Lib "storage.dll" (ByVal filename As String, ByVal backname As String) As Long Public Declare Function GetBit Lib "storage.dll" (ByVal bit As Long, ByVal Index As Integer) As Integer Public Declare Function GetBits Lib "storage.dll" (ByVal bit As String, ByVal l As Integer) As Long Public Declare Function ShowHelp Lib "storage.dll" (ByVal hwnd As Long, ByVal chmname As String, ByVal htmlname As String) As Long Public Declare Function AddWndMsg Lib "storage.dll" (ByVal hwnd As Long, ByVal msg As Long, ByVal procaddress As Long) As Long Public Declare Function ClearPrintData Lib "FxPrint.dll" () As Integer Public Declare Function SetPrintDataWidth Lib "FxPrint.dll" (ByVal width As Integer) As Integer Public Declare Function AddPrintData Lib "FxPrint.dll" (ByVal data As String) As Integer Public Declare Function ShowPrint Lib "FxPrint.dll" (ByVal title As String) As Integer Public Declare Function SaveToFile Lib "FxPrint.dll" () As Integer Public fMainForm As frmmain ';主窗口句柄 Public DataPath As String ';数据库路径 Public DataConnectString As String ';数据库连接源字符串 Public UserName As String ';用户名 Public UserPas As String ';用户密码 Public Purview As Long ';操作权限 Public 权限类别(16) As Integer ';17种权限类别 Public Function ShowPrintDlg(ByVal ado As Adodc, ByVal title As String) ';清除以前的打印数据 ClearPrintData Dim count As Integer On Error GoTo quit: count = ado.Recordset.Fields.count If count <= 0 Then MsgBox "没有需打印的数据", vbInformation Exit Function End If ';设置打印列宽度 SetPrintDataWidth count ';保存当前位置的状态pos Dim pos As Long pos = ado.Recordset.AbsolutePosition ';移到记录最前面 ado.Recordset.MoveFirst Dim i As Integer ';写入眉头 For i = 0 To count - 1 AddPrintData ado.Recordset.Fields(i).name Next ';写入数据 While ado.Recordset.EOF = False For i = 0 To count - 1 If ado.Recordset.Fields(i).ActualSize > 0 Then AddPrintData ado.Recordset.Fields(i).Value Else AddPrintData "" End If Next ado.Recordset.MoveNext Wend ';恢复以前的记录 ado.Recordset.MoveFirst If pos > 1 Then ado.Recordset.Move pos - 1 ShowPrint title Exit Function quit: MsgBox "没有打印数据或打印数据未初始化!", vbInformation End Function Public Function ShowHelpWnd(Index As Long) If Index = 0 Then ShowHelp fMainForm.hwnd, App.HelpFile, "" Else Dim htmlname As String htmlname = "进销存管理系统.htm/#" Dim v As String v = LTrim(Str(Index)) Dim i As Integer For i = 1 To Len(v) htmlname = htmlname + Mid(v, i, 1) If i <> Len(v) Then htmlname = htmlname + "_" Next ShowHelp fMainForm.hwnd, App.HelpFile, htmlname End If End Function ';屏蔽flash右键弹出菜单 Public Function FlashNoRButton(ByVal hwnd As Long, ByVal msg As Long, ByVal wparam As Long, ByVal lparam As Long) As Long FlashNoRButton = 1 End Function ';删除记录中的所有数据 Public Function DeleteRecordData(Re As Recordset) If Re.RecordCount <= 0 Then Exit Function Re.MoveFirst While Re.EOF = False Re.Delete Re.MoveFirst Wend End Function Sub Main() ';检测是否已运行 If App.PrevInstance Then MsgBox App.title + " 已运行!" End End If ';初始化数据库文件路径 DataPath = App.Path + "\db1.mdb" DataConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + DataPath + ";Persist Security Info=False" + ";Jet OLEDB:Database Password=prowind" ';启动起始屏 Frmsplash.Show vbModal ';启动登陆对话框 Dim fLogin As New Frmlogin fLogin.Show vbModal If Not fLogin.OK Then ';登录失败，退出应用程序 End End If Unload fLogin ';启动主窗口 Set fMainForm = New frmmain fMainForm.Show End Sub

什么意思啊

搞什么啊，不是说你们参加后  发的文章在这吗 好象就一人
上面的MM发的算什么意思啊