【VB开源代码栏目提醒】：文章导读：在新的一年中，各位网友都进入紧张的学习或是工作阶段。

    网学会员整理了VB开源代码-VB进销存管理系统及源代码 - 综合课件的相关内容供大家参考，祝大家在新的一年里工作和学习顺利！

VB进销存管理系统及源代码 Dim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim connstring As String Private Sub Form_Load On Error GoTo myerr 有异常跳转 adoXSD.CommandType adCmdText adoXSD.RecordSource quotselect 商品名称 from Product where 库存gt0quot 设置adoxsd的数据源为Product数据表 adoXSD.Refresh With adoXSD.Recordset .MoveFirst Do While Not .EOF 从第一条开始逐条添加到Combo1的子项中 DoEvents Combo1.AddItem 商品名称 .MoveNext Loop End With adoXSD.RecordSource quotselect 用户 from Usersquot 设置adoxsd的数据源为Users数据表 adoXSD.Refresh With adoXSD.Recordset .MoveFirst Do While Not .EOF 从第一条开始逐条添加到Combo2的子项中 DoEvents Combo2.AddItem 用户 .MoveNext Loop End With adoXSD.RecordSource quotselect 客户简称 from Customerquot 设置adoxsd的数据源为Customer数据表 adoXSD.Refresh With adoXSD.Recordset .MoveFirst Do While Not .EOF 从第一条开始逐条添加到Combo3的子项中 DoEvents Combo3.AddItem 客户简称 .MoveNext Loop End With adoXSD.RecordSource quotselect 票号 from Sale order by 票号quot 设置adoxsd的数据源为Sale数据表 adoXSD.Refresh With adoXSD.Recordset If .RecordCount gt 0 Then 如果已有记录则在原来的序号上递增 .MoveLast If 票号 ltgt quotquot Then Dim lsph As String lsph RightTrim票号 3 1 Text3.Text DateTime.Date amp quot-S-quot amp Formatlsph quot000quot End If Else 如果还没有记录则序号开始为001 Text3.Text DateTime.Date amp quot-S-quot amp quot001quot End If End With mebDate.Text DateTime.Date 系统当前日期的字符串形式赋值 myerr: End Sub Private Sub Form_UnloadCancel As Integer 将主窗体设置为可用并将其显示 frmMain.Enabled True frmMain.Show End Sub Private Sub Picture1_Click On Error GoTo err 首先检查商品名称字段。

    如果为空则提示不能为空然后将焦点转移到Combo1上 If TrimCombo1.Text quotquot Then If MsgBoxquot商品名称字段是必须要输入的quot vbExclamation quot提示quot vbOK Then Combo1.SetFocus End If Else 检查数量字段。

    如果为空则提示不能为空然后将焦点转移到Text8上 If Text8.Text quotquot Then If MsgBoxquot数量字段是必须要输入的quot vbExclamation quot提示quot vbOK Then Text8.SetFocus End If Else 检查单价字段。

    如果为空则提示不能为空然后将焦点转移到Text6上 If Text6.Text quotquot Then If MsgBoxquot单价字段是必须要输入的quot vbExclamation quot提示quot Then Text6.SetFocus End If Else 检查客户字段。

    如果为空则提示不能为空然后将焦点转移到Combo3上 If TrimCombo3.Text quotquot Then If MsgBoxquot客户字段是必须要输入的quot _ vbExclamation quot提示quot vbOK Then Combo3.SetFocus End If Else 检查经手人字段。

    如果为空则提示不能为空然后将焦点转移到Combo2上 If TrimCombo2.Text quotquot Then If MsgBoxquot经手人字段是必须要输入的quot _ vbExclamation quot提示quot vbOK Then Combo2.SetFocus End If Else 输入检测无误后可以提交数据 connstring quotProviderSQLOLEDB.1PasswordeccPersist Security quot _ amp quotInfoTrueUser IDsaInitial CatalogPurchaseandSaleServerlocalquot If conn.State ltgt 1 Then 打开数据库 conn.Open connstring End If Dim sql As String sql quotinsert into Sale 商品名称quot amp _ quot数量单价金额备注客户日期经手人票号 quot amp _ quotvalues quot amp TrimCombo1.Text amp quotquot _ amp TrimText8.Text amp quotquot amp TrimText6.Text amp quotquot _ amp TrimText7.Text amp quotquot amp TrimText9.Text amp quotquot amp _ TrimCombo3.Text amp quotquot amp TrimmebDate.Text amp _ quotquot amp TrimCombo2.Text amp quotquot amp TrimText3.Text amp quotquot conn.Execute sql 执行插入操作 conn.Close 如果没有发生异常就表明插入操作成功提示用户然后退出本窗口 If MsgBoxquot销售单成功生成quot vbInformation quot提示quot vbOK Then Unload Me End If End If End If End If End If End If err: End Sub Private Sub Text6_LostFocus On Error GoTo myerr If Text6.Text ltgt quotquot And Text8.Text ltgt quotquot Then 只有两个文本框中都输入了内容时才能计算金额 Text7.Text TrimText6.Text TrimText8.Text End If Exit Sub myerr: If MsgBoxquot价格必须是数值数量必须是整数quot vbInformation quot提示quot Then GoTo myerr1 myerr1: End Sub Private Sub Combo1_lostfocus connstring quotProviderSQLOLEDB.1PasswordeccPersist Security InfoTrueUser IDsaquot _ amp quotInitial CatalogpurchaseandSaleServerlocalquot If conn.State ltgt 1 Then 连接数据库 conn.Open connstring End If 在Product数据表中检索商品名称为Combo1中输入的值的记录将结果保存到rs记录集中 Set rs conn.Executequotselect 产地规格包装单位库存 from product where 商品名称quot _ amp TrimCombo1.Text amp quotquot With rs .MoveFirst Do While Not .EOF 将检索结果在相应的控件上显示出来 DoEvents Text1.Text 规格 Text4.Text 包装 Text2.Text 单位 Text5.Text 产地 Text8.Text 库存 .MoveNext Loop End With End Sub Private Sub Text8_LostFocus On Error GoTo myerr If Text6.Text ltgt quotquot And Text8.Text ltgt quotquot Then 只有两个文本框中都输入了内容时才能计算金额 Text7.Text TrimText6.Text TrimText8.Text End If Exit Sub myerr: If MsgBoxquot价格必须是数值数量必须是整数quot vbInformation quot提示quot Then GoTo myerr1 myerr1: End Sub Private Sub Command1_Click On Error GoTo myerr If TrimText1.Text quotquot Or TrimText2.Text quotquot Then If MsgBoxquot请输入查询条件quot vbInformation quot提示quot Then GoTo myerr End If adoXSCX.CommandType adCmdText adoXSCX.CommandType adCmdText adoXSCX.RecordSource quotselect from sale where quot amp TrimCombo1.Text _ amp TrimCombo2.Text amp quot quot amp TrimText1.Text amp quotquot amp quot quot _ amp TrimCombo3.Text amp quot quot amp TrimCombo4.Text amp _ TrimCombo5.Text amp quotquot amp TrimText2.Text amp quotquot adoXSCX.Refresh myerr: End Sub Private Sub Command2_Click Unload Me End Sub Private Sub dgdXSCX_Click End Sub Private Sub Form_Load Combo1.AddItem quot商品名称quot Combo1.AddItem quot客户quot Combo1.AddItem quot经手人quot Combo1.AddItem quot票号quot Combo1.ListIndex 0 Combo2.AddItem quotquot Combo2.AddItem quotgtquot Combo2.AddItem quotgtquot Combo2.AddItem quotltquot Combo2.AddItem quotltquot Combo2.AddItem quotltgtquot Combo2.ListIndex 0 Combo3.AddItem quotAndquot Combo3.AddItem quotOrquot Combo4.AddItem quot商品名称quot Combo4.AddItem quot客户quot Combo4.AddItem quot经手人quot Combo4.AddItem quot票号quot Combo4.ListIndex 0 Combo5.AddItem quotquot Combo5.AddItem quotgtquot Combo5.AddItem quotgtquot Combo5.AddItem quotltquot Combo5.AddItem quotltquot Combo5.AddItem quotltgtquot Combo5.ListIndex 0 End Sub Private Sub Form_UnloadCancel As Integer frmMain.Enabled True frmMain.Show End SubPrivate Sub Command1_Click adoMMSZ.CommandType adCmdText adoMMSZ.RecordSource quot select 用户 密码 from users where 用户quot _ amp TrimCombo1.Text amp quotquot adoMMSZ.Refresh With adoMMSZ.Recordset If .RecordCount lt 1 Then GoTo myerr .MoveFirst DoEvents strPwd 密码 If TrimText1.Text ltgt strPwd Then 输入的原密码错误 Dim a a MsgBoxquot对不起您输入的密码错误quot vbInformation quot提示quot Text1.SetFocus GoTo myerr End If If TrimText2.Text ltgt TrimText3.Text Then If MsgBoxquot对不起您两次输入的密码不一致请重新输入quot _ vbInformation quot提示quot vbYes Then End If Text2.SetFocus GoTo myerr End If End With adoMMSZ.Recordset.Fields1 TrimTrimText3.Text adoMMSZ.Recordset.Update adoMMSZ.Refresh If MsgBoxquot密码修改成功quot vbInformation quot提示quot vbOK Then frmMain.Hide frmMain.Show Unload Me End If myerr: End Sub Private Sub Command2_Click Unload Me End Sub Private Sub Form_Load adoMMSZ.Refresh With adoMMSZ.Recordset If .RecordCount gt 0 Then .MoveFirst 将Users数据表的“用户”字段逐条添加到Combo1的子项中 Do While Not .EOF DoEvents Combo1.AddItem 用户 .MoveNext Loop Combo1.ListIndex 0 End If End With End Sub Private Sub Form_UnloadCancel As Integer frmMain.Enabled True frmMain.Show End SubDim conn As New ADODB.Connection Dim rs As New ADODB.Recordset Dim connstring As String Dim num As Integer 用于保存密码输入错误次数 Private Sub CmdCancel_Click Unload frmLogin 卸载登录窗口 End Sub Private Sub cmdOK_Click If TrimcmbUserName.Text quotquot Then 首先要求用户名不能为空 MsgBox quot用户名不能为空quot vbOKOnly vbExclamation quot警告quot cmbUserName.SetFocus 将焦点转移到用户名组合框中 Exit Sub End If connstring quotProviderSQLOLEDB.1PasswordeccPersist Security InfoTrueUser IDsaquot _ amp quotInitial CatalogPurchaseandSaleServerlocalquot If conn.State ltgt 1 Then 如果数据库没有打开则打开数据库 conn.Open connstring End If Set rs conn.Executequotselect from users where 用户quot amp TrimcmbUserName.Text amp quotquot 在users数据表中检索用户字段值为用户输入的用户名的记录将结果存放在rs记录集中 If rs.EOF Then 如果记录为空则说明不存在此条记录也说明用户名错误 MsgBox quot 没有该用户quot amp vbCrLf amp quot 请重新输入quot vbOKOnly vbExclamation quot提示quot cmbUserName.SetFocus Exit Sub Else 存在此用户名检查密码 rs.MoveFirst If rs.Fieldsquot密码quot.Value TrimtxtPWD.Text Then 密码正确 Unload frmLogin 卸载登录窗口 Load frmMain 加载主窗口 frmMain.Show 显示主窗口 Else 密码错误 If num lt 2 Then 输入错误次数不足三次 num num 1 错误次数加1 MsgBox quot口令不对请重输quot amp vbCrLf amp quot 您还有quot amp Str3 - num amp quot次机会quot _ vbOKOnly vbExclamation quot提示quot 提示错误 txtPWD.SetFocus Exit Sub Else 输入错误打到3次提示后退出系统 MsgBox quot对不起您无权使用本系统quot vbOKOnly vbExclamation quot提示quot Unload frmLogin Exit Sub End If End If End If conn.Close 关闭数据库连接 End Sub Private Sub Form_Load connstring quotProviderSQLOLEDB.1PasswordeccPersist Security InfoTrueUser IDsaquot _ amp quotInitial CatalogPurchaseandSaleServerlocalquot 定义连接字符串 If conn.State ltgt 1 Then 如果数据库未打开则打开数据库 conn.Open connstring End If Set rs conn.Executequotselect from usersquot 执行查询操作结果保存在rs记录集中 With rs .MoveFirst Do While Not .EOF 逐条读取用户名称添加到cmbUserName组合框中 DoEvents cmbUserName.AddItem 用户 .MoveNext Loop End With cmbUserName.ListIndex 0 将cmbUserName组合框的默认选项设置为第一条 conn.Close End Sub Private Sub txtPWD_Change End Sub Dim x i 定义变量 Private Sub CmdRefresh_Click adoKHGL.CommandType adCmdText adoKHGL.RecordSource quotselect from customerquot adoKHGL.Refresh End Sub Private Sub cmdupdate_Click On Error GoTo myerr If gys0.Text ltgt quotquot And gys1.Text ltgt quotquot Then 客户简称和客户全称不能为空 For i 0 To 10 If gysi.Text ltgt quotquot Then adoKHGL.Recordset.Fieldsi Trimgysi.Text Next i adoKHGL.Recordset.Update 更新数据 adoKHGL.Refresh For i 0 To 3 更新完毕后记录可以移动 cmdMDi.Enabled True Next i cmdAdd.Enabled True cmdDelete.Enabled True cmdUpdate.Enabled False cmdRefresh.Enabled True Else If MsgBoxquot客户简称和客户全称都不能为空quot vbInformation quot提示quot vbOK Then gys0.SetFocus End If End If myerr: End Sub Private Sub Form_Load x Arrayquot客户简称quot quot客户全称quot quot地址quot quot邮政编码quot quot电话quot quot传真quot quot联系人quot For i 0 To 6 向combo1添加查询项目列表 Combo1.AddItem xi Next i Combo1.ListIndex 0 adoKHGL.Refresh If adoKHGL.Recordset.RecordCount gt 0 Then For i 0 To 10 初始化给gysi赋值 If adoKHGL.Recordset.Fieldsi ltgt quotquot Then gysi.Text adoKHGL.Recordset.Fieldsi Else gysi.Text quotquot End If Next i End If SSTab1.Tab 0 显示第一个选项卡 End Sub Private Sub Form_UnloadCancel As Integer frmMain.Enabled True frmMain.Show End Sub Private Sub CmdFind_Click 查询客户信息 adoKHGL.CommandType adCmdText adoKHGL.RecordSource quotselect from customer where quot amp TrimCombo1.Text amp _ quot like quot amp TrimText1.Text amp quotquot adoKHGL.Refresh If adoKHGL.Recordset.RecordCount gt 0 Then adoKHGL.Recordset.MoveFirst For i 0 To 10 将查询结果的第一条记录的字段显示 If adoKHGL.Recordset.Fieldsi ltgt quotquot Then gysi.Text adoKHGL.Recordset.Fieldsi Else gysi.Text quotquot End If Next i End If End Sub Private Sub Label8_Click End Sub Private Sub SSTab1_ClickPreviousTab As Integer If adoKHGL.Recordset.RecordCount gt 0 Then If SSTab1.Tab 1 And cmdAdd.Enabled False Then 当增加记录时不能切换到“客户列表”选项卡 MsgBox quot正在处理数据请取消数据处理再执行本操作quot SSTab1.Tab 0 Else 切换时将“客户信息”选项卡中信息更新为当前记录的信息 For i 0 To 10 If adoKHGL.Recordset.Fieldsi ltgt quotquot Then gysi.Text adoKHGL.Recordset.Fieldsi Else gysi.Text quotquot End If Next i End If dgdKHGL.Refresh End If End Sub Private Sub CmdMD_ClickIndex As Integer Select Case Index Case Is 0 移到第一条记录 If Not adoKHGL.Recordset.BOF Then adoKHGL.Recordset.MoveFirst Case Is 1 移到上一条记录 If adoKHGL.Recordset.RecordCount ltgt 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 ltgt 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.RecordC.