VB进销存管理系统及源代码

VB进销存管理系统及源代码Dim conn As New ADODB.ConnectionDim rs As New ADODB.RecordsetDim connstring As StringPrivate Sub Form_Load() On Error GoTo myerr 有异常跳转 adoXSD.CommandType = adCmdText adoXSD.RecordSource = select 商品名称 from Product where 库存0 设置adoxsd的数据源为Product数据表 adoXSD.Refresh With adoXSD.Recordset .MoveFirst Do While Not .EOF 从第一条开始逐条添加到Combo1的子项中 DoEvents Combo1.AddItem (!商品名称) .MoveNext Loop End With adoXSD.RecordSource = select 用户 from Users 设置adoxsd的数据源为Users数据表 adoXSD.Refresh With adoXSD.Recordset .MoveFirst Do While Not .EOF 从第一条开始逐条添加到Combo2的子项中 DoEvents Combo2.AddItem (!用户) .MoveNext Loop End With adoXSD.RecordSource = select 客户简称 from Customer 设置adoxsd的数据源为Customer数据表 adoXSD.Refresh With adoXSD.Recordset .MoveFirst Do While Not .EOF 从第一条开始逐条添加到Combo3的子项中 DoEvents Combo3.AddItem (!客户简称) .MoveNext Loop End With adoXSD.RecordSource = select 票号 from Sale order by 票号 设置adoxsd的数据源为Sale数据表 adoXSD.Refresh With adoXSD.Recordset If .RecordCount 0 Then 如果已有记录则在原来的序号上递增 .MoveLast If !票号 Then Dim lsph As String lsph = Right(Trim(!票号), 3) + 1 Text3.Text = DateTime.Date$ & -S- & Format(lsph, 000) End If Else 如果还没有记录则序号开始为001 Text3.Text = DateTime.Date$ & -S- & 001 End If End With mebDate.Text = DateTime.Date$ 系统当前日期的字符串形式赋值myerr:End SubPrivate Sub Form_Unload(Cancel As Integer) 将主窗体设置为可用，并将其显示 frmMain.Enabled = True frmMain.ShowEnd SubPrivate Sub Picture1_Click() On Error GoTo err 首先检查商品名称字段。如果为空，则提示不能为空，然后将焦点转移到Combo1上 If Trim(Combo1.Text) = Then If MsgBox(商品名称字段是必须要输入的！, vbExclamation, 提示！) = vbOK Then Combo1.SetFocus End If Else 检查数量字段。如果为空，则提示不能为空，然后将焦点转移到Text8上 If Text8.Text = Then If MsgBox(数量字段是必须要输入的！, vbExclamation, 提示！) = vbOK Then Text8.SetFocus End If Else 检查单价字段。如果为空，则提示不能为空，然后将焦点转移到Text6上 If Text6.Text = Then If MsgBox(单价字段是必须要输入的！, vbExclamation, 提示！) Then Text6.SetFocus End If Else 检查客户字段。如果为空，则提示不能为空，然后将焦点转移到Combo3上 If Trim(Combo3.Text) = Then If MsgBox(客户字段是必须要输入的！, _ vbExclamation, 提示！) = vbOK Then Combo3.SetFocus End If Else 检查经手人字段。如果为空，则提示不能为空，然后将焦点转移到Combo2上 If Trim(Combo2.Text) = Then If MsgBox(经手人字段是必须要输入的！, _ vbExclamation, 提示！) = vbOK Then Combo2.SetFocus End If Else 输入检测无误后可以提交数据 connstring = Provider=SQLOLEDB.1;Password=ecc;Persist Security _ & Info=True;User ID=sa;Initial Catalog=PurchaseandSale;Server=(local) If conn.State 1 Then 打开数据库 conn.Open (connstring) End If Dim sql As String sql = insert into Sale (商品名称, & _ 数量,单价,金额,备注,客户,日期,经手人,票号) & _ values ( & Trim(Combo1.Text) & , _ & Trim(Text8.Text) & , & Trim(Text6.Text) & , _ & Trim(Text7.Text) & , & Trim(Text9.Text) & , & _ Trim(Combo3.Text) & , & Trim(mebDate.Text) & _ , & Trim(Combo2.Text) & , & Trim(Text3.Text) & ) conn.Execute (sql) 执行插入操作 conn.Close 如果没有发生异常就表明插入操作成功，提示用户，然后退出本窗口 If MsgBox(销售单成功生成！, vbInformation, 提示) = vbOK Then Unload Me End If End If End If End If End If End Iferr:End SubPrivate Sub Text6_LostFocus() On Error GoTo myerr If Text6.Text And Text8.Text Then 只有两个文本框中都输入了内容时才能计算金额 Text7.Text = Trim(Text6.Text) * Trim(Text8.Text) End If Exit Submyerr: If MsgBox(价格必须是数值，数量必须是整数！, vbInformation, 提示！) Then GoTo myerr1myerr1:End SubPrivate Sub Combo1_lostfocus() connstring = Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa; _ & Initial Catalog=purchaseandSale;Server=(local) If conn.State 1 Then 连接数据库 conn.Open (connstring) End If 在Product数据表中检索商品名称为Combo1中输入的值的记录，将结果保存到rs记录集中 Set rs = conn.Execute(select 产地,规格,包装,单位,库存 from product where 商品名称= _ & Trim(Combo1.Text) & ) With rs .MoveFirst Do While Not .EOF 将检索结果在相应的控件上显示出来 DoEvents Text1.Text = !规格 Text4.Text = !包装 Text2.Text = !单位 Text5.Text = !产地 Text8.Text = !库存 .MoveNext Loop End WithEnd SubPrivate Sub Text8_LostFocus() On Error GoTo myerr If Text6.Text And Text8.Text Then 只有两个文本框中都输入了内容时才能计算金额 Text7.Text = Trim(Text6.Text) * Trim(Text8.Text) End If Exit Submyerr: If MsgBox(价格必须是数值，数量必须是整数！, vbInformation, 提示！) Then GoTo myerr1 myerr1:End SubPrivate Sub Command1_Click() On Error GoTo myerr If Trim(Text1.Text) = Or Trim(Text2.Text) = Then If MsgBox(请输入查询条件！, vbInformation, 提示) Then GoTo myerr End If adoXSCX.CommandType = adCmdText adoXSCX.CommandType = adCmdText adoXSCX.RecordSource = select * from sale where & Trim(Combo1.Text) _ & Trim(Combo2.Text) & & Trim(Text1.Text) & & _ & Trim(Combo3.Text) & & Trim(Combo4.Text) & _ Trim(Combo5.Text) & & Trim(Text2.Text) & adoXSCX.Refreshmyerr:End SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub dgdXSCX_Click()End SubPrivate Sub Form_Load() Combo1.AddItem (商品名称) Combo1.AddItem (客户) Combo1.AddItem (经手人) Combo1.AddItem (票号) Combo1.ListIndex = 0 Combo2.AddItem (=) Combo2.AddItem () Combo2.AddItem (=) Combo2.AddItem () Combo2.AddItem (=) Combo2.AddItem () Combo2.ListIndex = 0 Combo3.AddItem (And) Combo3.AddItem (Or) Combo4.AddItem (商品名称) Combo4.AddItem (客户) Combo4.AddItem (经手人) Combo4.AddItem (票号) Combo4.ListIndex = 0 Combo5.AddItem (=) Combo5.AddItem () Combo5.AddItem (=) Combo5.AddItem () Combo5.AddItem (=) Combo5.AddItem () Combo5.ListIndex = 0End SubPrivate Sub Form_Unload(Cancel As Integer) frmMain.Enabled = True frmMain.ShowEnd SubPrivate Sub Command1_Click() adoMMSZ.CommandType = adCmdText adoMMSZ.RecordSource = select 用户 ,密码 from users where 用户= _ & Trim(Combo1.Text) & adoMMSZ.Refresh With adoMMSZ.Recordset If .RecordCount 1 Then GoTo myerr .MoveFirst DoEvents strPwd = !密码 If Trim(Text1.Text) strPwd Then 输入的原密码错误 Dim a a = MsgBox(对不起，您输入的密码错误！, vbInformation, 提示) Text1.SetFocus GoTo myerr End If If Trim(Text2.Text) Trim(Text3.Text) Then If MsgBox(对不起，您两次输入的密码不一致，请重新输入！, _ vbInformation, 提示) = vbYes Then End If Text2.SetFocus GoTo myerr End If End With adoMMSZ.Recordset.Fields(1) = Trim(Trim(Text3.Text) adoMMSZ.Recordset.Update adoMMSZ.Refresh If MsgBox(密码修改成功！, vbInformation, 提示) = vbOK Then frmMain.Hide frmMain.Show Unload Me End Ifmyerr:End SubPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Form_Load() adoMMSZ.Refresh With adoMMSZ.Recordset If .RecordCount 0 Then .MoveFirst 将Users数据表的“用户”字段逐条添加到Combo1的子项中 Do While Not .EOF DoEvents Combo1.AddItem (!用户) .MoveNext Loop Combo1.ListIndex = 0 End If End WithEnd SubPrivate Sub Form_Unload(Cancel As Integer)frmMain.Enabled = TruefrmMain.ShowEnd SubDim conn As New ADODB.ConnectionDim rs As New ADODB.RecordsetDim connstring As StringDim num As Integer 用于保存密码输入错误次数Private Sub CmdCancel_Click() Unload frmLogin 卸载登录窗口End SubPrivate Sub cmdOK_Click() If Trim(cmbUserName.Text) = Then 首先要求用户名不能为空 MsgBox 用户名不能为空！, vbOKOnly + vbExclamation, 警告！ cmbUserName.SetFocus 将焦点转移到用户名组合框中 Exit Sub End If connstring = Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa; _ & Initial Catalog=PurchaseandSale;Server=(local) If conn.State 1 Then 如果数据库没有打开则打开数据库 conn.Open (connstring) End If Set rs = conn.Execute(select * from users where 用户= & Trim(cmbUserName.Text) & ) 在users数据表中检索用户字段值为用户输入的用户名的记录，将结果存放在rs记录集中 If rs.EOF Then 如果记录为空则说明不存在此条记录，也说明用户名错误 MsgBox 没有该用户！ & vbCrLf & 请重新输入！, vbOKOnly + vbExclamation, 提示 cmbUserName.SetFocus Exit Sub Else 存在此用户名，检查密码 rs.MoveFirst If rs.Fields(密码).Value = Trim(txtPWD.Text) Then 密码正确 Unload frmLogin 卸载登录窗口 Load frmMain 加载主窗口 frmMain.Show 显示主窗口 Else 密码错误 If num 2 Then 输入错误次数不足三次 num = num + 1 错误次数加1 MsgBox 口令不对，请重输！ & vbCrLf & 您还有 & Str(3 - num) & 次机会！, _ vbOKOnly + vbExclamation, 提示 提示错误 txtPWD.SetFocus Exit Sub Else 输入错误打到3次，提示后退出系统 MsgBox 对不起，您无权使用本系统！, vbOKOnly + vbExclamation, 提示 Unload frmLogin Exit Sub End If End If End If conn.Close 关闭数据库连接End SubPrivate Sub Form_Load() connstring = Provider=SQLOLEDB.1;Password=ecc;Persist Security Info=True;User ID=sa; _ & Initial Catalog=PurchaseandSale;Server=(local) 定义连接字符串 If conn.State 1 Then 如果数据库未打开，则打开数据库 conn.Open (connstring) End If Set rs = conn.Execute(select * from users) 执行查询操作，结果保存在rs记录集中 With rs .MoveFirst Do While Not .EOF 逐条读取用户名称，添加到cmbUserName组合框中 DoEvents cmbUserName.AddItem (!用户) .MoveNext Loop End With cmbUserName.ListIndex = 0 将cmbUserName组合框的默认选项设置为第一条 conn.CloseEnd SubPrivate Sub txtPWD_Change()End SubDim x, i 定义变量Private Sub CmdRefresh_Click() adoKHGL.CommandType = adCmdText adoKHGL.RecordSource = select * from customer adoKHGL.RefreshEnd SubPrivate Sub cmdupdate_Click() On Error GoTo myerr If gys(0).Text And gys(1).Text Then 客户简称和客户全称不能为空 For i = 0 To 10 If gys(i).Text Then adoKHGL.Recordset.Fields(i) = Trim(gys(i).Text) Next i adoKHGL.Recordset.Update 更新数据 adoKHGL.Refresh For i = 0 To 3 更新完毕后记录可以移动 cmdMD(i).Enabled = True Next i cmdAdd.Enabled = True cmdDelete.Enabled = True cmdUpdate.Enabled = False cmdRefresh.Enabled = True Else If MsgBox(客户简称和客户全称都不能为空！, vbInformation, 提示) = vbOK Then gys(0).SetFocus End If End Ifmyerr:End SubPrivate Sub Form_Load() x = Array(客户简称, 客户全称, 地址, 邮政编码, 电话, 传真, 联系人) For i = 0 To 6 向combo1添加查询项目列表 Combo1.AddItem (x(i) Next i Combo1.ListIndex = 0 adoKHGL.Refresh If adoKHGL.Recordset.RecordCount 0 Then For i = 0 To 10 初始化给gys(i)赋值 If adoKHGL.Recordset.Fields(i) Then gys(i).Text = adoKHGL.Recordset.Fields(i) Else gys(i).Text = End If Next i End If SSTab1.Tab = 0 显示第一个选项卡End SubPrivate Sub Form_Unload(Cancel As Integer) frmMain.Enabled = True frmMain.ShowEnd SubPrivate Sub CmdFind_Click() 查询客户信息 adoKHGL.CommandType = adCmdText adoKHGL.RecordSource = select * from customer where & Trim(Combo1.Text) & _ like & Trim(Text1.Text) & % adoKHGL.Refresh If adoKHGL.Recordset.RecordCount 0 Then adoKHGL.Recordset.MoveFirst For i = 0 To 10 将查询结果的第一条记录的字段显示 If adoKHGL.Recordset.Fields(i) Then gys(i).Text = adoKHGL.Recordset.Fields(i) Else gys(i).Text = End If Next i End IfEnd SubPrivate Sub Label8_Click()End SubPrivate Sub SSTab1_Click(PreviousTab As Integer) If adoKHGL.Recordset.RecordCount 0 Then If SSTab1.Tab = 1 And cmdAdd.Enabled = False Then 当增加记录时不能切换到“客户列表”选项卡 MsgBox (正在处理数据,请取消数据处理,再执行本操作!) SSTab1.Tab = 0 Else 切换时将“客户信息”选项卡中信息更新为当前记录的信息 For i = 0 To 10 If adoKHGL.Recordset.Fields(i) Then gys(i).Text = adoKHGL.Recordset.Fields(i) Else gys(i).Text = End If Next i End If dgdKHGL.Refresh End IfEnd SubPrivate Sub CmdMD_Click(Index As Integer) Select Case Index Case Is = 0 移到第一条记录 If Not adoKHGL.Recordset.BOF Then adoKHGL.Recordset.MoveFirst Case Is = 1 移到上一条记录 If adoKHGL.Recordset.RecordCount 0 Then If adoKHGL.Recordset.BOF = False Then adoKHGL.Recordset.MovePrevious If adoKHGL.Recordset.BOF = True Then adoKHGL.Recordset.MoveFirst End If Case Is = 2 移到下一条记录 If adoKHGL.Recordset.RecordCount 0 Then If adoKHGL.Recordset.EOF = False Then adoKHGL.Recordset.MoveNext If adoKHGL.Recordset.EOF = True Then adoKHGL.Recordset.MoveLast End If Case Is = 3 移到最后一条记录 If adoKHGL.Recordset.RecordCount 0 Then If adoKHGL.Recordset.EOF = False Then adoKHGL.Recordset.MoveNext If adoKHGL.Recordset.EOF = True Then adoKHGL.Recordset.MoveLast End If End Select For i = 0 To 10 If adoKHGL.Recordset.Fields(i) Then gys(i).Text = adoKHGL.Recordset.Fields(i) Else gys(i).Text = End If Next iEnd SubPrivate Sub cmdAdd_Click() 允许用户添加新记录 adoKHGL.CommandType = adCmdText adoKHGL.RecordSource = select * from customer adoKHGL.Refresh adoKHGL.Recordset.AddNew For i = 0 To 10 设置文本框可用，且初始值为空 gys(i).Text = gys(i).Enabled = True Next i For i = 0 To 3 增加记录时记录不可移动 cmdMD(i).Enabled = False Next i cmdAdd.Enabled = False cmdUpdate.Enabled = True 增加记录时只可保存或退出 cmdRefresh.Enabled = False cmdDelete.Enabled = False SSTab1.Tab = 0 在“客户信息”选项卡中输入信息 gys(0).SetFocus 焦点转移到第一个字段上End SubPrivate Sub cmdDelete_Click() 删除客户信息 If adoKHGL.Recordset.RecordCount 0 Then If MsgBox(您确实要删除这条数据吗?, vbYesNo + vbQuestion, 提示) = vbYes Then adoKHGL.Recordset.Delete adoKHGL.Refresh adoKHGL.Recordset.MoveFirst For i = 0 To 3 cmdMD(i).Enabled = True Next i cmdAdd.Enabled = True cmdUpdate.Enabled = True cmdDelete.Enabled = True cmdRefresh.Enabled = True For i = 0 To 10 gys(i).Text = adoKHGL.Recordset.Fields(i) Next i End If Else MsgBox (没有要删除的数据!) End IfEnd SubPrivate Sub cmdend_Click() Unload MeEnd SubPrivate Sub Command1_Click() On Error GoTo myerr Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim strUpdate As String Dim connstring As String strUpdate = update product set 库存 = (select sum(数量) from purchase where & _ 商品名称=product.商品名称) - (select sum(数量) from sale where & _ 商品名称=product.商品名称) connstring = Provider=SQLOLEDB.1;Password=ecc;Persist Security _ & Info=True;User ID=sa;Initial Catalog=PurchaseandSale;Server=(local) If conn.State 1 Then 打开数据库 conn.Open (connstring) End If conn.Execute (strUpdate) 执行库存盘点操作 conn.Close adoKCPD.Refresh 刷新库存myerr: End SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub dgdKCPD_Click()End Su