VB(仓库管理系统源代码)

合集下载

仓库管理系统(VB+Access+源代码)

精心整理仓库管理系统项目的建立这是本人利用闲暇之余在VB6.0上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。

由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。

此文可作供初学者们学习交流。

作者联系方式：E-mail最终运行效果打开软件出现如下登录界面输入系统预设用户名及密码（1 1）单击“登录”或单击“新用户”添加新用户进入如下主界面：建立工程1、创建标准EXE2、按“打开”3、添加MDI窗体——打开4、编辑菜单在空白处右击——点击“菜单编辑器”在“标题”里输入“系统”，在“名称”里输入“Sys”（注意此处不能为汉字）点击“下一个”再点击“”“确定”退到MDI界面点击“系统”——“退出”如下，然后编写代码。

代码如下：PrivateSubExit_Click()EndEndSub数据库的建立VB6.0中可以创建Access数据库。

如下建立一个“用户表”的数据库，用来存放用户信息及一些出入库管理信息。

如下图单击“外接程序”再单击“可视化数据管理器”出现如图点击“文件”——“新建”——“MicrosoftAccess”——“Version2.0MDB”输入数据库名，“保存”出现如下图在数据窗口中右击——“新建表”，最终如下往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。

精心整理精心整理登录界面窗口的建立最终界面如下：1、Adodc1的添加过程为：单击“工程”——“部件”出现下图所示，选择“控件”下的“MicrosoftADODataControl6.0（OLEDB）”单击“确定”在工具栏中会出现“”图标，单击它并拖动到相应位置即可。

其它元件不在一一说明。

2、本窗体代码如下：PrivateSubCommand1_Click() ' “登录”、“确定”按钮IfCommand1.Caption=" 确定"AndCommand2.Caption=" 取消"Then ' 如果为“确定”则添加新用户IfText1.Text=""Then ' 提示用户输入用户名MsgBox" 请输入用户名！",," 登录信息提示："ExitSubElse 'DimusenameAsString ' 检测用户名是否已经存在DimstrSAsStringusename=Trim(Text1.Text)strS="select*from 用户登录信息表where 用户名='"&usename&"'"mandType=adCmdTextAdodc1.RecordSource=strSAdodc1.RefreshMsgBox" 您输入的用户已存在 !",," 登录提示信息："Text1.Text=""Text2.Text=""Text3.Text=""Text1.SetFocusExitSubEndIfEndIfIfText2.Text=""Then ' 提示用户密码不能为空MsgBox" 密码不能为空!",," 登录提示信息："Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox" 请再次输入密码!",," 登录提示信息："Text3.SetFocusExitSubEndIfIfText2.Text<>Text3.TextThenMsgBox" 两次输入的密码不一致,请确认!",," 登录提示信息："Text2.Text=""Text3.Text=""Text2.SetFocus精心整理精心整理ExitSubElseMsgBox(" 添加新用户成功，现在您可以登陆系统了！")Label3.Visible=FalseText3.Visible=FalseCommand1.Caption=" 登录"Command2.Caption=" 退出"EndIfElse ' “登录”按钮，用户登录DimstrSnoAsStringDimstrSelectAsStringstrSno=Trim(Text1.Text) ' 检测用户名是否存在strSelect="select 密码from 用户登录信息表where 用户名='"&strSno&"'"mandType=adCmdTextAdodc1.RecordSource=strSelectAdodc1.RefreshMsgBox" 用户名不存在，请重新输入！",," 登录提示信息："Text1.Text=""Text2.Text=""Text1.SetFocusExitSubEndIfForm1.Hide'UnloadMeForm2.Show'MsgBox" 登陆成功！",," 登录提示信息："ElseMsgBox" 密码不正确，请重新输入！",," 登录提示信息："Text2.Text=""Text2.SetFocusEndIfEndIfEndSubPrivateSubCommand2_Click() ' “退出”或“取消”按钮IfCommand2.Caption=" 取消"ThenLabel3.Visible=FalseText3.Visible=FalseCommand1.Caption=" 登录"Command2.Caption=" 退出"Text1.Text=""Text2.Text=""Text1.SetFocusElseEnd'UnloadMeEndIfEndSub精心整理精心整理PrivateSubCommand3_Click() ' “新用户”按钮Label3.Visible=TrueText3.Visible=TrueText1.Text=""Text2.Text=""Text3.Text=""Command1.Caption=" 确定"Command2.Caption=" 取消"Text1.SetFocusEndSubPrivateSubCommand3_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)Label6.Visible=TrueEndSubPrivateSubCommand3_MouseUp(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle)Label6.Visible=FalseEndSubPrivateSubForm_Load()Label3.Visible=FalseText3.Visible=FalseEndSubPrivateSubTimer1_Timer() ' 时间time1控件的time事件代码，用来' 显示向左移动的欢迎字幕IfLabel4.Left+Label4.Width>0Then ' 当标签右边位置大于0时，标签向左移Label4.MoveLabel4.Left-80Else ' 否则标签从头开始Label4.Left=Form1.ScaleWidthEndIfIfLabel5.Left+Label5.Width>0ThenLabel5.MoveLabel5.Left-80ElseLabel5.Left=Form1.ScaleWidthEndIfEndSub主界面窗体如下：代码：PrivateSubAddNew_Click() Frame1.Visible=TrueFrame2.Visible=FalseEndSubPrivateSubCHKPMCHX_Click()Frame2.Caption=" 出库信息"DimpmAsString精心整理精心整理DimnAsStringpm=InputBox(" 产品名"," 请输入",0)n="select*from 出库表where 品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubCHKXHCHX_Click()Frame2.Caption=" 出库信息"DimXHAsStringDimnAsStringXH=InputBox(" 产品型号"," 请输入",0)n="select*from 出库表where 型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndSubPrivateSubCKCZ_Click()'Form2.HideForm6.ShowEndSubPrivateSubCKJSHR_Click()Frame2.Caption=" 出库信息"DimJSHRAsStringDimnAsStringJSHR=InputBox(" 经手人"," 请输入",0)n="select*from 出库表where 经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubCKSHJ_Click()Frame2.Caption=" 出库信息"DimCHKRQAsStringDimnAsStringCHKRQ=InputBox(" 出库日期，格式为：月/日/年如：12/1/2011"," 请输入",0) n="select*from 出库表where 出库日期='"&CHKRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubCKZCX_Click()Frame2.Caption=" 出库信息" 精心整理精心整理DimZBAsStringZB="select*from 出库表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid1EndSubPrivateSubCommand1_Click()IfText1.Text=""Then ' 提示用户输入用户名MsgBox" 请输入用户名！",," 登录信息提示："ExitSubElse 'DimusenameAsString ' 检测用户名是否已经存在DimstrSAsStringusename=Trim(Text1.Text)strS="select*from 用户登录信息表where 用户名='"&usename&"'"mandType=adCmdTextAdodc1.RecordSource=strSAdodc1.RefreshMsgBox" 您输入的用户已存在!",," 登录提示信息："Text1.Text=""Text2.Text=""Text3.Text=""Text1.SetFocusExitSubEndIfEndIfIfText2.Text=""Then ' 提示用户密码不能为空MsgBox" 密码不能为空!",," 登录提示信息："Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox" 请再次输入密码!",," 登录提示信息："Text3.SetFocusExitSubEndIfIfText2.Text<>Text3.TextThenMsgBox" 两次输入的密码不一致,请确认!",," 登录提示信息："Text2.Text=""Text3.Text=""Text2.SetFocusExitSubElseeDimXAsInteger 精心整理精心整理X=MsgBox(" 成功添加新用户，是否要重新登录!",vbYesNo+vbQuestion+vbDefaultButton1," 提示信息!") IfX=vbYesThenUnloadMeForm3.ShowEndIf'MsgBox(" 成功添加新用户！")'Label3.Visible=False'Text3.Visible=False'Command1.Caption=" 登录"'Command2.Caption=" 退出"EndIfFrame1.Visible=FalseFrame2.Visible=TrueText1.Text=""Text2.Text="'"Text3.Text=""'Form3.ShowEndSubPrivateSubCommand2_Click()Frame1.Visible=FalseFrame2.Visible=TrueEndSubPrivateSubCXDL_Click()Form3.Show'UnloadMeEndSubPrivateSubExit_Click()EndUnloadForm1UnloadForm2UnloadForm3UnloadForm4UnloadForm5UnloadForm6UnloadForm7UnloadForm8EndSubPrivateSubForm_Load()UnloadForm1Frame1.Visible=FalseCallInitGrid0Me.Height=MDIForm1.Height-1060 Me.Width=MDIForm1.Width-560Me.Top=MDIForm1.TopMe.Left=MDIForm1.LeftEndSub精心整理精心整理PrivateSubGHCZ_Click()'Form2.HideForm8.ShowEndSubPrivateSubGHPMCX_Click()Frame2.Caption=" 归还信息"DimpmAsStringDimnAsStringpm=InputBox(" 产品名"," 请输入",0)n="select*from 归还表where 品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubGHRCX_Click()Frame2.Caption=" 归还信息"DimJCRAsStringDimnAsStringJCR=InputBox(" 归还人"," 请输入",0)n="select*from 归还表where 归还人='"&JCR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubGHSJCX_Click()Frame2.Caption=" 归还信息"DimJCRQAsStringDimnAsStringJCRQ=InputBox(" 归还日期，格式为：月/日/年如：12/1/2011"," 请输入",0) n="select*from 归还表where 归还日期='"&JCRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubGHXHCX_Click()Frame2.Caption=" 归还信息"DimXHAsStringDimnAsStringXH=InputBox(" 产品型号"," 请输入",0) n="select*from 归还表where 型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.Refresh精心整理精心整理CallInitGrid2EndSubPrivateSubGHZCX_Click()Frame2.Caption=" 归还信息"DimZBAsStringZB="select*from 归还表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCCZ_Click()'Form2.HideForm7.ShowEndSubPrivateSubJCHPMCHX_Click()Frame2.Caption=" 借出信息"DimpmAsStringDimnAsStringpm=InputBox(" 产品名"," 请输入",0)n="select*from 借出表where 品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCHXHCHX_Click()Frame2.Caption=" 借出信息"DimXHAsStringDimnAsStringXH=InputBox(" 产品型号"," 请输入",0) n="select*from 借出表where 型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCRCX_Click()Frame2.Caption=" 借出信息"DimJCRAsStringDimnAsStringJCR=InputBox(" 借出人"," 请输入",0) n="select*from 借出表where 借出人='"&JCR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.Refresh精心整理精心整理CallInitGrid2EndSubPrivateSubJCSHJCX_Click()Frame2.Caption=" 借出信息"DimJCRQAsStringDimnAsStringJCRQ=InputBox(" 借出日期，格式为：月/日/年如：12/1/2011"," 请输入",0) n="select*from 借出表where 借出日期='"&JCRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCZCX_Click()Frame2.Caption=" 借出信息"DimZBAsStringZB="select*from 借出表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid2EndSubPrivateSubJSHRCHX_Click()Frame2.Caption=" 归还信息"DimJSHRAsStringDimnAsStringJSHR=InputBox(" 经手人"," 请输入",0)n="select*from 归还表where 经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJSHRCX_Click()Frame2.Caption=" 借出信息"DimJSHRAsStringDimnAsStringJSHR=InputBox(" 经手人"," 请输入",0)n="select*from 借出表where 经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubPMCX_Click()Frame2.Caption=" 库存信息" 精心整理精心整理DimpmAsStringDimnAsStringpm=InputBox(" 产品名"," 请输入",0)n="select*from 库存表where 品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid0EndSubPrivateSubRKCZ_Click()'Form2.HideForm5.ShowEndSubPrivateSubRKJSHR_Click()Frame2.Caption=" 入库信息"DimJSHRAsStringDimnAsStringJSHR=InputBox(" 经手人"," 请输入",0)n="select*from 入库表where 经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubRKPMCHX_Click()Frame2.Caption=" 入库信息"DimpmAsStringDimnAsStringpm=InputBox(" 产品名"," 请输入",0)IfLen(pm)>0Thenn="select*from 入库表where 品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndIfCallInitGrid1EndSubPrivateSubRKSHJ_Click()Frame2.Caption=" 入库信息"DimRKRQAsStringDimnAsStringRKRQ=InputBox(" 入库日期，格式为：月/日/年如：12/1/2011"," 请输入",0) n="select*from 入库表where 入库日期='"&RKRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.Refresh精心整理精心整理CallInitGrid1EndSubPrivateSubRKXHCHX_Click()Frame2.Caption=" 入库信息"DimXHAsStringDimnAsStringXH=InputBox(" 产品型号"," 请输入",0)IfLen(XH)>0Thenn="select*from 入库表where 型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndIfCallInitGrid1EndSubPrivateSubRKZCX_Click()Frame2.Caption=" 入库信息"DimZBAsStringZB="select*from 入库表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid1EndSubPrivateSubTimer1_Timer()IfLabel4.Left+Label4.Width>0Then ' 当标签右边位置大于0时，标签向左移Label4.MoveLabel4.Left-80Else ' 否则标签从头开始Label4.Left=Form2.ScaleWidthEndIfIfLabel5.Left+Label5.Width>0ThenLabel5.MoveLabel5.Left-80ElseLabel5.Left=Form2.ScaleWidthEndIfIfLabel6.Left+Label6.Width>0ThenLabel6.MoveLabel6.Left-80ElseLabel6.Left=Form2.ScaleWidthEndIfIfLabel7.Left+Label7.Width>0Then Label7.MoveLabel7.Left-80ElseLabel7.Left=Form2.ScaleWidthEndIfEndSub精心整理精心整理PrivateSubXGMM_Click()'Form2.HideForm4.ShowEndSubPrivateSubXHCX_Click()Frame2.Caption=" 库存信息"DimXHAsStringDimnAsStringXH=InputBox(" 产品型号"," 请输入",0) IfLen(XH)>0Then'AndVal(XH)<>0n="select*from 库存表where 型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndIfCallInitGrid0EndSubPrivateSubZB_Click()Frame2.Caption=" 库存信息"DimZBAsString'DimNAsString'PM=InputBox(" 产品名"," 请输入",0) ZB="select*from 库存表"'where 品名='"&PM&"'"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid0EndSubPrivateSubInitGrid0()WithDataGrid1.Columns(0).Width=1600.Columns(1).Width=2200.Columns(2).Width=2200.Columns(3).Width=1000.Columns(4).Width=1000.Columns(5).Width=4000EndWithEndSubPrivateSubInitGrid1()WithDataGrid1.Columns(0).Width=800.Columns(1).Width=1600.Columns(2).Width=1600.Columns(3).Width=800.Columns(4).Width=800.Columns(5).Width=1000 精心整理精心整理.Columns(6).Width=800.Columns(7).Width=4000EndWithEndSubPrivateSubInitGrid2()WithDataGrid1'.Columns(0).Caption=" 学号"'.Columns(1).Caption=" 课程名"'.Columns(2).Caption=" 学分"'.Columns(3).Caption=" 成绩"' 设置DtgCond的列宽.Columns(0).Width=800.Columns(1).Width=1600.Columns(2).Width=1600.Columns(3).Width=800.Columns(4).Width=800.Columns(5).Width=800.Columns(6).Width=1000.Columns(7).Width=800.Columns(8).Width=4000EndWithEndSub用户重新登录界面代码：PrivateSubCommand1_Click()DimstrSnoAsStringDimstrSelectAsStringstrSno=Trim(Text1.Text) ' 检测用户名是否存在strSelect="select 密码from 用户登录信息表where 用户名='"&strSno&"'"mandType=adCmdTextAdodc1.RecordSource=strSelectAdodc1.RefreshMsgBox" 用户名不存在，请重新输入！",," 登录提示信息："Text1.Text=""Text2.Text=""Text1.SetFocusExitSubEndIfUnloadMeForm2.Show'MsgBox" 登陆成功！",," 登录提示信息："ElseMsgBox" 密码不正确，请重新输入！",," 登录提示信息：" 精心整理精心整理Text2.Text=""Text2.SetFocusEndIfEndSubPrivateSubCommand2_Click()UnloadMeForm2.ShowEndSub修改用户密码界面代码：PrivateSubCommand1_Click()IfTrim(Text1.Text)<>Form2.TextUserNameThenMsgBox" 用户名不正确，请确认！",," 信息提示！"Text1.Text=""Text1.SetFocusExitSubElseDimnameAsStringDimnamesAsStringname=Trim(Text1.Text)names="select*from 用户登录信息表where 用户名='"&name&"'" mandType=adCmdTextAdodc1.RecordSource=namesAdodc1.RefreshIfText2.Text=""ThenMsgBox" 请输入旧密码!",," 信息提示！"Text2.SetFocusExitSubEndIfMsgBox" 旧密码不正确，请确认!",," 信息提示！"Text2.Text=""Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox" 请输入新密码!",," 信息提示！"Text3.SetFocusExitSubEndIfIfText4.Text=""ThenMsgBox" 请再次输入新密码!",," 信息提示！"Text4.SetFocusExitSub精心整理精心整理EndIfIfTrim(Text3.Text)<>Trim(Text4.Text)ThenMsgBox" 两次输入的新密码不一致!",," 信息提示！"Text3.Text=""Text4.Text=""Text3.SetFocusExitSubElseMsgBox(" 密码修改成功！")UnloadMe'Form2.ShowEndIfEndIfEndSubPrivateSubCommand2_Click()UnloadMe'Form2.ShowEndSub入库管理代码：PrivateSubCommand1_Click()IfText1.Text=""AndText2.Text=""ThenMsgBox" “品名”和“型号”不能同时为空，必须输入其中一项 !",," 提示信息!" ExitSubText1.SetFocusElseIfText3.Text=""AndText4.Text=""ThenMsgBox" 请输入产品“数量”或“单位”之一 !",," 提示信息!"Text3.SetFocusExitSubEndIfIfText5.Text=""ThenMsgBox" 请经手人签名!",vbCritical," 提示信息!"Text5.SetFocusExitSubEndIfAdodc1.Refresh EndIf DimpmAsString DimpmsAsString DimnAsString DimmAsStringpm=Trim(Text1.Text) 精心整理精心整理n=Val(Text3.Text)pms="select*from 库存表where 品名='"&pm&"'"WithForm2EndWithElseEndIfEndIfDimXAsIntegerX=MsgBox(" 产品入库登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1," 提示信息!") IfX=vbNoThenUnloadMe'Form2.ShowElseText1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""Text5.Text=""Text6.Text=""Text7.Text=""Text1.SetFocusEndIfDimZBAsStringZB="select*from 入库表"'where 品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""Text5.Text=""Text6.Text=""Text7.Text=""Text1.SetFocusEndSubPrivateSubCommand3_Click()UnloadMe'Form2.ShowEndSub出库管理代码：PrivateSubCommand1_Click()IfCombo1.Text=""AndCombo2.Text=""Then'text1.Text=""AndText2.Text=""Then 精心整理精心整理MsgBox" “品名”和“型号”不能同时为空，必须输入其中一项 !",," 提示信息!" ExitSubElseIfText1.Text=""AndCombo3.Text=""Then'Text4.Text=""ThenMsgBox" 请输入产品“数量”或“单位”之一 !",," 提示信息!"Text2.SetFocusExitSubEndIfIfText2.Text=""ThenMsgBox" 请经手人签名!",vbCritical," 提示信息!"Text2.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Combo1.Text)n=Val(Text1.Text)pms="select*from 库存表where 品名='"&pm&"'"EndIfDimXAsIntegerX=MsgBox(" 产品出库登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1," 提示信息!") IfX=vbNoThenUnloadMe'Form2.ShowEndIfCombo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""DimZBAsStringZB="select*from 出库表"'where 品名='"&PM&"'" EndSubPrivateSubCommand2_Click()Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""精心整理精心整理Text4.Text=""EndSubPrivateSubCommand3_Click()UnloadMe'Form2.ShowEndSubPrivateSubForm_Load()Adodc2.RefreshLoopEndSub借出管理代码：PrivateSubCommand1_Click()IfCombo1.Text=""AndCombo2.Text=""Then'text1.Text=""AndText2.Text=""Then MsgBox" “品名”和“型号”不能同时为空，必须输入其中一项 !",," 提示信息!" ExitSubElseIfText1.Text=""AndCombo3.Text=""Then'Text4.Text=""ThenMsgBox" 请输入产品“数量”或“单位”之一 !",," 提示信息!"Text1.SetFocusExitSubEndIfIfText2.Text=""ThenMsgBox" 请经手人签名!",vbCritical," 提示信息!"Text2.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Combo1.Text)n=Val(Text1.Text)pms="select*from 库存表where 品名='"&pm&"'"EndIfDimXAsIntegerX=MsgBox(" 产品借出登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1," 提示信息!") IfX=vbNoThenUnloadMeForm2.ShowEndIf精心整理精心整理Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""DimZBAsStringZB="select*from 借出表"'where 品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""EndSubPrivateSubCommand3_Click()UnloadMeForm2.ShowEndSubPrivateSubForm_Load()Adodc2.RefreshLoopEndSub归还管理代码：PrivateSubCommand1_Click()IfCombo1.Text=""AndCombo2.Text=""Then'text1.Text=""AndText2.Text=""Then MsgBox" “品名”和“型号”不能同时为空，必须输入其中一项 !",," 提示信息!" ExitSubElseIfText1.Text=""AndCombo3.Text=""Then'Text4.Text=""ThenMsgBox" 请输入产品“数量”或“单位”之一 !",," 提示信息!"Text1.SetFocusExitSubEndIfIfText2.Text=""ThenMsgBox" 请经手人签名!",vbCritical," 提示信息!"Text2.SetFocusExitSub精心整理精心整理EndIfIfText3.Text=""ThenMsgBox" 请输入归还人姓名!",vbCritical," 提示信息!"Text3.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Combo1.Text)n=Val(Text1.Text)pms="select*from 库存表where 品名='"&pm&"'"EndIfDimXAsIntegerX=MsgBox(" 产品归还登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1," 提示信息!") IfX=vbNoThenUnloadMeForm2.ShowEndIfCombo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""DimZBAsStringZB="select*from 归还表"'where 品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""EndSub PrivateSubCommand3_Click() UnloadMeForm2.ShowEndSubPrivateSubForm_Load()精心整理精心整理'DimiAsString'i=0'Adodc2.Refresh'i=i+1'LoopCallpmEndSubPrivateSubpm() DimiAsVariant DimjAsVariant DimkAsVariant DimaAsVariant DimbAsVariant DimcAsVariant DimsAsVariant DimDAsVarianti=0j=0Adodc2.Refreshi=i+1LoopD=Split(a,",")Ifj<iThens=D(2)Combo1.AddItems'k=0'Ifk<jAndD(k)<>D(j)Then'IfD(k)<>D(j)Then'C ombo1.AddItemD(j)'k=k+1'Else'k=k+1'EndIf'EndIfj=j+1EndIfText5.Text=s'a+","+D(2)+D(1)'+""+Val(i)+""+Val(j)+""+Val(k) Text6.Text=j'Combo1.AddItemD(1)EndSub精心整理。

VB仓库管理系统源代码

.1.请购作业程序Private Sub ComCX_Click()'查询'在编号文本框中输入编号，连接数据库，查询编号，并将编号?品名?规格?单位?单价的数据分别导入到相应文本框。

Set CN = New ADODB.ConnectionSet Rs = New ADODB.RecordsetCN.Open Provider=Microsoft.Jet.OLEDB.4.0;Data Source= & F:\VB设计专用\仓库数据资料\仓库数据资料.mdb;Persist Security Info=False'打开数据库Rs.CursorType = adOpenStatic '制定一个静态游标Rs.LockType = adLockOptimistic '设置锁定模式为开放式Rs.Open select * from JLBH where FtextBHSJ Like' & % & Trim(textBHSJ.Text)& % & ', CNDoEventsDo Until Rs.EOF = TrueIf Rs.EOF = False ThenlistBHSJ1.AddItem (Rs.Fields(0))listPMSJ1.AddItem (Rs.Fields(1))listGGSJ1.AddItem (Rs.Fields(2))listDWSJ1.AddItem (Rs.Fields(3))listDJSJ1.AddItem (Rs.Fields(4))专业资料Word.Rs.MoveNextEnd IfLoopEnd SubPrivate Sub comFHZY_Click()'返回上页frmQGZY.HidefrmCKGLXT.ShowEnd SubPrivate Sub comQD_Click()'录入数据If textBHSJ.Text = \ Or textPMSJ.Text = \ Or textGGSJ.Text = \ Or textDWSJ.Text = \ Or textDJSJ.Text = \ Or textQGSLSJ.Text = \ Then獍?硯尠请将数据补充完整!textBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDWSJ.Text = \textDJSJ.Text = \textQGSLSJ.Text = \Else专业资料Word.Dim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = Select textBHSJ From qgzy where textBHSJ= ' & Trim(textBHSJ.Text) & 'strconn = Provider=Microsoft.Jet.OLEDB.4.0;Data Source='strconn = strconn & F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)str1=InsertIntoqgzy(textBHSJ,textPMSJ,textGGSJ,textDWSJ,textDJSJ,textQGSJ)str1 = str1 + Values(' & Trim(textBHSJ.Text) & ',' & Trim(textPMSJ.Text) & ',' & Trim(textGGSJ.Text) & ',' & Trim(textDWSJ.Text) & ',' & Trim(textDJSJ.Text) & ',' & Trim(textQGSLSJ.Text) & ')cnn.Execute str1listBHSJ1.AddItem (Trim(textBHSJ.Text))listPMSJ1.AddItem (Trim(textPMSJ.Text))listGGSJ1.AddItem (Trim(textGGSJ.Text))listDWSJ1.AddItem (Trim(textDWSJ.Text))listDJSJ1.AddItem (Trim(textDJSJ.Text))专业资料Word.listQGSLSJ1.AddItem (Trim(textQGSLSJ.Text))獍?硯尠数据输入成功!rst.Closecnn.CloseSet Rs = NothingSet CN = NothingtextBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDWSJ.Text = \textDJSJ.Text = \textQGSLSJ.Text = \End IfEnd SubPrivate Sub comsc_Click()'删除If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) Then专业资料Word.textBHSJ.Text = listBHSJ1.List(i)textPMSJ.Text = listPMSJ1.List(i)textGGSJ.Text = listGGSJ1.List(i)textDWSJ.Text = listDWSJ1.List(i)textDJSJ.Text = listDJSJ1.List(i)textQGSLSJ.Text = listQGSLSJ1.List(i) End IfNextEnd IfDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = Select FtextBHSJ From jlbh where FtextBHSJ=' & Trim(textBHSJ.Text) & 'strconn = Provider=Microsoft.Jet.OLEDB.4.0;Data Source='strconn = strconn & F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)If rst.EOF = False Thenstr1 = Delete from qgzy where FtextBHSJ=' & Trim(textBHSJ.Text) & 'cnn.Execute str1专业资料Word.textBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDWSJ.Text = \textDJSJ.Text = \If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThenlistBHSJ1.RemoveItem (i)listPMSJ1.RemoveItem (i)listGGSJ1.RemoveItem (i)listDWSJ1.RemoveItem (i)listDJSJ1.RemoveItem (i)listQGSLSJ1.RemoveItem (i)End IfNextEnd If獍?硯尠数据已删除！Else专业资料Word.獍?硯尠无此数据！textBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDJSJ.Text = \textQGSLSJ.Text = \End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingEnd Sub‘以下是listbox串连显示Private Sub listBHSJ1_Click()If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) ThenlistPMSJ1.Selected(i) = TrueEnd If专业资料Word.NextEnd IfPrivate Sub listDJSJ1_Click()If listDJSJ1.SelCount > 0 ThenFor i = listDJSJ1.ListCount - 1 To 0 Step -1If listDJSJ1.Selected(i) ThenlistQGSLSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listDWSJ1_Click()If listDWSJ1.SelCount > 0 ThenFor i = listDWSJ1.ListCount - 1 To 0 Step -1 If listDWSJ1.Selected(i) ThenlistDJSJ1.Selected(i) = TrueEnd IfNextEnd If专业资料Word.Private Sub listGGSJ1_Click()If listGGSJ1.SelCount > 0 ThenFor i = listGGSJ1.ListCount - 1 To 0 Step -1 If listGGSJ1.Selected(i) ThenlistDWSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listPMSJ1_Click()If listPMSJ1.SelCount > 0 ThenFor i = listPMSJ1.ListCount - 1 To 0 Step -1 If listPMSJ1.Selected(i) ThenlistGGSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd Sub专业资料Word.Private Sub listQGSLSJ1_Click()If listQGSLSJ1.SelCount > 0 ThenFor i = listQGSLSJ1.ListCount - 1 To 0 Step -1 If listQGSLSJ1.Selected(i) ThenlistBHSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd Sub2.增加料号程序Private Sub comFHZY_Click()'返回上页frmJLBH.HidefrmCKGLXT.ShowEnd SubPrivate Sub comSCBH_Click()'删除If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThentextBHSJ.Text = listBHSJ1.List(i)textPMSJ.Text = listPMSJ1.List(i)专业资料Word.textGGSJ.Text = listGGSJ1.List(i)textDWSJ.Text = listDWSJ1.List(i)textDJSJ.Text = listDJSJ1.List(i)End IfNextEnd IfDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = Select FtextBHSJ From jlbh where FtextBHSJ=' & Trim(textBHSJ.Text) & 'strconn = Provider=Microsoft.Jet.OLEDB.4.0;Data Source='strconn = strconn & F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)If rst.EOF = False Thenstr1 = Delete * from jlbh where FtextBHSJ=' & Trim(textBHSJ.Text) & 'cnn.Execute str1textBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \专业资料Word.textDWSJ.Text = \textDJSJ.Text = \If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThenlistBHSJ1.RemoveItem (i)listPMSJ1.RemoveItem (i)listGGSJ1.RemoveItem (i)listDWSJ1.RemoveItem (i)listDJSJ1.RemoveItem (i)End IfNextEnd If獍?硯尠编号已删除！Else獍?硯尠无此编号！请确认后重新输入textBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDWSJ.Text = \textDJSJ.Text = \专业资料Word.End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingEnd SubPrivate Sub comZJBH_Click()'新增料号If textBHSJ.Text = \ Or textPMSJ.Text = \ Or textGGSJ.Text = \ Or textDWSJ.Text = \ Or textDJSJ.Text = \ Then獍?硯尠请将数据补充完整!textBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDWSJ.Text = \textDJSJ.Text = \ElseDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = Select FtextBHSJ From jlbh where FtextBHSJ= ' & Trim(textBHSJ.Text) 专业资料Word.& 'strconn = Provider=Microsoft.Jet.OLEDB.4.0;Data Source='strconn = strconn & F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)If rst.EOF = False Then獍?硯尠该编号已存在，不能追加！Elsestr1 = Insert Into jlbh (FtextBHSJ,FtextPMSJ,FtextGGSJ,FtextDWSJ,FtextDJSJ) str1 = str1 + Values(' & Trim(textBHSJ.Text) & ',' & Trim(textPMSJ.Text) & ',' & Trim(textGGSJ.Text) & ',' & Trim(textDWSJ.Text) & ',' & Trim(textDJSJ.Text)cnn.Execute str1listBHSJ1.AddItem (Trim(textBHSJ.Text))listPMSJ1.AddItem (Trim(textPMSJ.Text))listGGSJ1.AddItem (Trim(textGGSJ.Text))listDWSJ1.AddItem (Trim(textDWSJ.Text))listDJSJ1.AddItem (Trim(textDJSJ.Text))獍?硯尠恭喜您，添加成功!专业资料Word.End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingtextBHSJ.Text = \textPMSJ.Text = \textGGSJ.Text = \textDWSJ.Text = \textDJSJ.Text = \End Sub‘以下是listbox循环选中程序Private Sub listBHSJ1_Click()If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) ThenlistPMSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd Sub专业资料Word.Private Sub listDJSJ1_Click()If listDJSJ1.SelCount > 0 ThenFor i = listDJSJ1.ListCount - 1 To 0 Step -1If listDJSJ1.Selected(i) ThenlistBHSJ1.Selected(i) = TrueEnd IfNextEnd IfPrivate Sub listDWSJ1_Click()If listDWSJ1.SelCount > 0 ThenFor i = listDWSJ1.ListCount - 1 To 0 Step -1 If listDWSJ1.Selected(i) ThenlistDJSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listGGSJ1_Click()If listGGSJ1.SelCount > 0 Then专业资料Word.For i = listGGSJ1.ListCount - 1 To 0 Step -1If listGGSJ1.Selected(i) ThenlistDWSJ1.Selected(i) = TrueEnd IfNextEnd IfPrivate Sub listPMSJ1_Click()If listPMSJ1.SelCount > 0 ThenFor i = listPMSJ1.ListCount - 1 To 0 Step -1 If listPMSJ1.Selected(i) ThenlistGGSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd Sub专业资料Word。

仓库管理系统(VB Access 源代码)

仓库管理系统项目的建立这是本人利用闲暇之余在VB6.0上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。

由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。

此文可作供初学者们学习交流。

作者联系方式：E-mail luo.shiye@ QQ：1355044347最终运行效果打开软件出现如下登录界面主界面：1、创建标准EXE2、按“打开”3、添加MDI窗体——打开4、编辑菜单在空白处右击——点击“菜单编辑器”在“标题”里输入“系统”，在“名称”里输入“Sys”（注意此处不能为汉字）点击“下一个”再点击“”“确定”退到MDI界面点击“系统”——“退出”如下，然后编写代码。

代码如下：Private Sub Exit_Click()EndEnd Sub数据库的建立VB6.0中可以创建Access数据库。

如下建立一个“用户表”的数据库，用来存放用户信息及一些出入库管理信息。

如下图单击“外接程序”再单击“可视化数据管理器”出现如图点击“文件”——“新建”——“Microsoft Access”——“Version 2.0 MDB”输入数据库名，“保存”出现如下图在数据窗口中右击——“新建表”，最终如下往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。

登录界面窗口的建立最终界面如下：1、Adodc1的添加过程为：单击“工程”——“部件”出现下图所示，选择“控件”下的“Microsoft ADO Data Control 6.0 （OLEDB）”单击“确定”在工具栏中会出现“”图标，单击它并拖动到相应位置即可。

其它元件不在一一说明。

2、本窗体代码如下：Private Sub Command1_Click() '“登录”、“确定”按钮 If Command1.Caption = "确定" And Command2.Caption = "取消" Then '如果为“确定”则添加新用户 If Text1.Text = "" Then '提示用户输入用户名MsgBox "请输入用户名！", , "登录信息提示："Exit SubElse 'Dim usename As String '检测用户名是否已经存在 Dim strS As Stringusename = Trim(Text1.Text)strS = "select * from 用户登录信息表 where 用户名='" & usename & "'"mandType = adCmdTextAdodc1.RecordSource = strSAdodc1.RefreshIf Adodc1.Recordset.EOF = False ThenMsgBox "您输入的用户已存在!", , "登录提示信息："Text1.Text = ""Text3.Text = ""Text1.SetFocusExit SubEnd IfEnd IfIf Text2.Text = "" Then '提示用户密码不能为空MsgBox "密码不能为空!", , "登录提示信息："Text2.SetFocusExit SubEnd IfIf Text3.Text = "" ThenMsgBox "请再次输入密码!", , "登录提示信息："Text3.SetFocusExit SubEnd IfIf Text2.Text <> Text3.Text ThenMsgBox "两次输入的密码不一致,请确认!", , "登录提示信息："Text2.Text = ""Text3.Text = ""Text2.SetFocusExit SubElseAdodc1.Recordset.AddNew '添加新用户Adodc1.Recordset.Fields("用户名") = Trim(Text1.Text)Adodc1.Recordset.Fields("密码") = Trim(Text2.Text)Adodc1.Recordset.UpdateMsgBox ("添加新用户成功，现在您可以登陆系统了！")Label3.Visible = FalseText3.Visible = FalseCommand1.Caption = "登录"Command2.Caption = "退出"End IfElse '“登录”按钮，用户登录 Dim strSno As StringDim strSelect As StringstrSno = Trim(Text1.Text) '检测用户名是否存在strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'"mandType = adCmdTextAdodc1.RecordSource = strSelectAdodc1.RefreshIf Adodc1.Recordset.EOF = True ThenMsgBox "用户名不存在，请重新输入！", , "登录提示信息："Text1.Text = ""Text1.SetFocusExit SubEnd IfIf Adodc1.Recordset.Fields("密码") = Trim(Text2.Text) Then '检测密码是否正确Form1.Hide'Unload MeForm2.Show'MsgBox "登陆成功！", , "登录提示信息："ElseMsgBox "密码不正确，请重新输入！", , "登录提示信息："Text2.Text = ""Text2.SetFocusEnd IfEnd IfEnd SubPrivate Sub Command2_Click() '“退出”或“取消”按钮 If Command2.Caption = "取消" ThenLabel3.Visible = FalseText3.Visible = FalseCommand1.Caption = "登录"Command2.Caption = "退出"Text1.Text = ""Text2.Text = ""Text1.SetFocusElseEnd 'Unload MeEnd IfEnd SubPrivate Sub Command3_Click() '“新用户”按钮Label3.Visible = TrueText3.Visible = TrueText1.Text = ""Text2.Text = ""Text3.Text = ""Command1.Caption = "确定"Command2.Caption = "取消"Text1.SetFocusEnd SubPrivate Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)Label6.Visible = TrueEnd SubPrivate Sub Command3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)Label6.Visible = FalseEnd SubPrivate Sub Form_Load()Label3.Visible = FalseText3.Visible = FalseEnd SubPrivate Sub Timer1_Timer() '时间time1控件的time事件代码，用来'显示向左移动的欢迎字幕If Label4.Left + Label4.Width > 0 Then '当标签右边位置大于0时，标签向左移Label4.Move Label4.Left - 80Else '否则标签从头开始Label4.Left = Form1.ScaleWidthEnd IfIf Label5.Left + Label5.Width > 0 ThenLabel5.Move Label5.Left - 80ElseLabel5.Left = Form1.ScaleWidthEnd IfEnd Sub主界面窗体如下：代码：Private Sub AddNew_Click()Frame1.Visible = TrueFrame2.Visible = FalseEnd SubPrivate Sub CHKPMCHX_Click()Frame2.Caption = "出库信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 出库表 where 品名 = '" & pm & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid1End SubPrivate Sub CHKXHCHX_Click()Frame2.Caption = "出库信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)n = "select * from 出库表 where 型号 = '" & XH & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshEnd SubPrivate Sub CKCZ_Click()'Form2.HideForm6.ShowEnd SubPrivate Sub CKJSHR_Click()Frame2.Caption = "出库信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 出库表 where 经手人 = '" & JSHR & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid1End SubPrivate Sub CKSHJ_Click()Frame2.Caption = "出库信息"Dim CHKRQ As StringDim n As StringCHKRQ = InputBox("出库日期，格式为：月/日/年如：12/1/2011", "请输入", 0)n = "select * from 出库表 where 出库日期 = '" & CHKRQ & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid1End SubPrivate Sub CKZCX_Click()Frame2.Caption = "出库信息"Dim ZB As StringZB = "select * from 出库表 "mandType = adCmdTextAdodc2.RecordSource = ZBAdodc2.RefreshCall InitGrid1End SubPrivate Sub Command1_Click()If Text1.Text = "" Then '提示用户输入用户名MsgBox "请输入用户名！", , "登录信息提示："Exit SubElse 'Dim usename As String '检测用户名是否已经存在 Dim strS As Stringusename = Trim(Text1.Text)strS = "select * from 用户登录信息表 where 用户名='" & usename & "'"mandType = adCmdTextAdodc1.RecordSource = strSAdodc1.RefreshIf Adodc1.Recordset.EOF = False ThenMsgBox "您输入的用户已存在!", , "登录提示信息："Text1.Text = ""Text2.Text = ""Text3.Text = ""Text1.SetFocusExit SubEnd IfEnd IfIf Text2.Text = "" Then '提示用户密码不能为空 MsgBox "密码不能为空!", , "登录提示信息："Text2.SetFocusExit SubEnd IfIf Text3.Text = "" ThenMsgBox "请再次输入密码!", , "登录提示信息："Text3.SetFocusExit SubEnd IfIf Text2.Text <> Text3.Text ThenMsgBox "两次输入的密码不一致,请确认!", , "登录提示信息："Text2.Text = ""Text3.Text = ""Text2.SetFocusExit SubElseAdodc1.Recordset.AddNew '添加新用户Adodc1.Recordset.Fields("用户名") = Trim(Text1.Text)Adodc1.Recordset.Fields("密码") = Trim(Text2.Text)Adodc1.Recordset.UpdateDim X As IntegerX = MsgBox("成功添加新用户，是否要重新登录!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbYes ThenUnload MeForm3.ShowEnd If'MsgBox ("成功添加新用户！")'Label3.Visible = False'Text3.Visible = False'Command1.Caption = "登录"'Command2.Caption = "退出"End IfFrame1.Visible = FalseFrame2.Visible = TrueText1.Text = ""Text2.Text = "'"Text3.Text = ""'Form3.ShowEnd SubPrivate Sub Command2_Click()Frame1.Visible = FalseFrame2.Visible = TrueEnd SubPrivate Sub CXDL_Click()Form3.Show'Unload MeEnd SubPrivate Sub Exit_Click()EndUnload Form1Unload Form3Unload Form4Unload Form5Unload Form6Unload Form7Unload Form8End SubPrivate Sub Form_Load()TextUserName = Trim(Form1.Text1.Text)Unload Form1Frame1.Visible = FalseCall InitGrid0Me.Height = MDIForm1.Height - 1060Me.Width = MDIForm1.Width - 560Me.Top = MDIForm1.TopMe.Left = MDIForm1.LeftEnd SubPrivate Sub GHCZ_Click()'Form2.HideForm8.ShowEnd SubPrivate Sub GHPMCX_Click()Frame2.Caption = "归还信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 归还表 where 品名 = '" & pm & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub GHRCX_Click()Frame2.Caption = "归还信息"Dim JCR As StringDim n As StringJCR = InputBox("归还人", "请输入", 0)n = "select * from 归还表 where 归还人 = '" & JCR & "'" mandType = adCmdTextAdodc2.RecordSource = nCall InitGrid2End SubPrivate Sub GHSJCX_Click()Frame2.Caption = "归还信息"Dim JCRQ As StringDim n As StringJCRQ = InputBox("归还日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 归还表 where 归还日期 = '" & JCRQ & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub GHXHCX_Click()Frame2.Caption = "归还信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)n = "select * from 归还表 where 型号 = '" & XH & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub GHZCX_Click()Frame2.Caption = "归还信息"Dim ZB As StringZB = "select * from 归还表 "mandType = adCmdTextAdodc2.RecordSource = ZBAdodc2.RefreshCall InitGrid2End SubPrivate Sub JCCZ_Click()'Form2.HideForm7.ShowEnd SubPrivate Sub JCHPMCHX_Click()Frame2.Caption = "借出信息"Dim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 借出表 where 品名 = '" & pm & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub JCHXHCHX_Click()Frame2.Caption = "借出信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)n = "select * from 借出表 where 型号 = '" & XH & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub JCRCX_Click()Frame2.Caption = "借出信息"Dim JCR As StringDim n As StringJCR = InputBox("借出人", "请输入", 0)n = "select * from 借出表 where 借出人 = '" & JCR & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub JCSHJCX_Click()Frame2.Caption = "借出信息"Dim JCRQ As StringDim n As StringJCRQ = InputBox("借出日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 借出表 where 借出日期 = '" & JCRQ & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub JCZCX_Click()Frame2.Caption = "借出信息"ZB = "select * from 借出表 "mandType = adCmdTextAdodc2.RecordSource = ZBAdodc2.RefreshCall InitGrid2End SubPrivate Sub JSHRCHX_Click()Frame2.Caption = "归还信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 归还表 where 经手人 = '" & JSHR & "'" mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub JSHRCX_Click()Frame2.Caption = "借出信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 借出表 where 经手人 = '" & JSHR & "'" mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid2End SubPrivate Sub PMCX_Click()Frame2.Caption = "库存信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 库存表 where 品名 = '" & pm & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid0End SubPrivate Sub RKCZ_Click()'Form2.HideForm5.ShowEnd SubPrivate Sub RKJSHR_Click()Frame2.Caption = "入库信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 入库表 where 经手人 = '" & JSHR & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid1End SubPrivate Sub RKPMCHX_Click()Frame2.Caption = "入库信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)If Len(pm) > 0 Thenn = "select * from 入库表 where 品名 = '" & pm & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshEnd IfCall InitGrid1End SubPrivate Sub RKSHJ_Click()Frame2.Caption = "入库信息"Dim RKRQ As StringDim n As StringRKRQ = InputBox("入库日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 入库表 where 入库日期 = '" & RKRQ & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshCall InitGrid1End SubPrivate Sub RKXHCHX_Click()Frame2.Caption = "入库信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)If Len(XH) > 0 Thenn = "select * from 入库表 where 型号 = '" & XH & "'"mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshEnd IfCall InitGrid1End SubPrivate Sub RKZCX_Click()Frame2.Caption = "入库信息"Dim ZB As StringZB = "select * from 入库表 "mandType = adCmdTextAdodc2.RecordSource = ZBAdodc2.RefreshCall InitGrid1End SubPrivate Sub Timer1_Timer()If Label4.Left + Label4.Width > 0 Then '当标签右边位置大于0时，标签向左移Label4.Move Label4.Left - 80Else '否则标签从头开始Label4.Left = Form2.ScaleWidthEnd IfIf Label5.Left + Label5.Width > 0 ThenLabel5.Move Label5.Left - 80ElseLabel5.Left = Form2.ScaleWidthEnd IfIf Label6.Left + Label6.Width > 0 ThenLabel6.Move Label6.Left - 80ElseLabel6.Left = Form2.ScaleWidthEnd IfIf Label7.Left + Label7.Width > 0 ThenLabel7.Move Label7.Left - 80ElseLabel7.Left = Form2.ScaleWidthEnd IfEnd SubPrivate Sub XGMM_Click()'Form2.HideForm4.ShowEnd SubPrivate Sub XHCX_Click()Frame2.Caption = "库存信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)If Len(XH) > 0 Then 'And Val(XH) <> 0n = "select * from 库存表 where 型号 = '" & XH & "'" mandType = adCmdTextAdodc2.RecordSource = nAdodc2.RefreshEnd IfCall InitGrid0End SubPrivate Sub ZB_Click()Frame2.Caption = "库存信息"Dim ZB As String'Dim N As String'PM = InputBox("产品名", "请输入", 0)ZB = "select * from 库存表 " 'where 品名 = '" & PM & "'" mandType = adCmdTextAdodc2.RecordSource = ZBAdodc2.RefreshCall InitGrid0End SubPrivate Sub InitGrid0()With DataGrid1.Columns(0).Width = 1600.Columns(1).Width = 2200.Columns(2).Width = 2200.Columns(3).Width = 1000.Columns(4).Width = 1000.Columns(5).Width = 4000End WithEnd SubPrivate Sub InitGrid1()With DataGrid1.Columns(0).Width = 800.Columns(1).Width = 1600.Columns(2).Width = 1600.Columns(3).Width = 800.Columns(4).Width = 800.Columns(5).Width = 1000.Columns(6).Width = 800.Columns(7).Width = 4000End WithEnd SubPrivate Sub InitGrid2()With DataGrid1'.Columns(0).Caption = "学号"' .Columns(1).Caption = "课程名"'.Columns(2).Caption = "学分"' .Columns(3).Caption = "成绩"'设置DtgCond的列宽.Columns(0).Width = 800.Columns(1).Width = 1600.Columns(2).Width = 1600.Columns(3).Width = 800.Columns(4).Width = 800.Columns(5).Width = 800.Columns(6).Width = 1000.Columns(7).Width = 800.Columns(8).Width = 4000End WithEnd Sub用户重新登录界面代码：Private Sub Command1_Click()Dim strSno As StringDim strSelect As StringstrSno = Trim(Text1.Text) '检测用户名是否存在 strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'"mandType = adCmdTextAdodc1.RecordSource = strSelectAdodc1.RefreshIf Adodc1.Recordset.EOF = True ThenMsgBox "用户名不存在，请重新输入！", , "登录提示信息："Text1.Text = ""Text2.Text = ""Text1.SetFocusExit SubEnd IfIf Adodc1.Recordset.Fields("密码") = Trim(Text2.Text) Then '检测密码是否正确 Unload MeForm2.Show'MsgBox "登陆成功！", , "登录提示信息："ElseMsgBox "密码不正确，请重新输入！", , "登录提示信息："Text2.Text = ""Text2.SetFocusEnd IfEnd SubPrivate Sub Command2_Click()Unload MeForm2.ShowEnd Sub修改用户密码界面代码：Private Sub Command1_Click()If Trim(Text1.Text) <> Form2.TextUserName ThenMsgBox "用户名不正确，请确认！", , "信息提示！"Text1.Text = ""Text1.SetFocusExit SubElseDim name As StringDim names As Stringname = Trim(Text1.Text)names = "select * from 用户登录信息表 where 用户名='" & name & "'" mandType = adCmdTextAdodc1.RecordSource = namesAdodc1.RefreshIf Text2.Text = "" ThenMsgBox "请输入旧密码!", , "信息提示！"Text2.SetFocusExit SubEnd IfIf Adodc1.Recordset.Fields("密码") <> Trim(Text2.Text) ThenMsgBox "旧密码不正确，请确认!", , "信息提示！"Text2.Text = ""Text2.SetFocusExit SubEnd IfIf Text3.Text = "" ThenMsgBox "请输入新密码!", , "信息提示！"Text3.SetFocusExit SubEnd IfIf Text4.Text = "" ThenMsgBox "请再次输入新密码!", , "信息提示！"Text4.SetFocusExit SubEnd IfIf Trim(Text3.Text) <> Trim(Text4.Text) ThenMsgBox "两次输入的新密码不一致!", , "信息提示！"Text3.Text = ""Text4.Text = ""Text3.SetFocusExit SubElseAdodc1.Recordset.Fields("密码") = Trim(Text3.Text)Adodc1.Recordset.UpdateMsgBox ("密码修改成功！")Unload Me'Form2.ShowEnd IfEnd IfEnd SubPrivate Sub Command2_Click()Unload Me'Form2.ShowEnd Sub入库管理代码：Private Sub Command1_Click()If Text1.Text = "" And Text2.Text = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"Exit SubText1.SetFocusElseIf Text3.Text = "" And Text4.Text = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Text3.SetFocusExit SubEnd IfIf Text5.Text = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Text5.SetFocusExit SubEnd IfAdodc1.RefreshAdodc1.Recordset.AddNew '添加 Adodc1.Recordset.Fields("品名") = Trim(Text1.Text)Adodc1.Recordset.Fields("型号") = Trim(Text2.Text)Adodc1.Recordset.Fields("数量") = Trim(Text3.Text)Adodc1.Recordset.Fields("单位") = Trim(Text4.Text)Adodc1.Recordset.Fields("经手人") = Trim(Text5.Text)Adodc1.Recordset.Fields("入库日期") = DateAdodc1.Recordset.Fields("说明") = Trim(Text7.Text)Adodc1.Recordset.UpdateEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trim(Text1.Text)n = Val(Text3.Text)pms = "select * from 库存表 where 品名='" & pm & "'"mandType = adCmdTextForm2.Adodc2.RecordSource = pmsForm2.Adodc2.RefreshIf Form2.Adodc2.Recordset.EOF ThenWith Form2.Adodc2.Recordset.AddNew.Adodc2.Recordset.Fields("品名") = Trim(Text1.Text).Adodc2.Recordset.Fields("型号") = Trim(Text2.Text).Adodc2.Recordset.Fields("数量") = Trim(Text3.Text).Adodc2.Recordset.Fields("单位") = Trim(Text4.Text).Adodc2.Recordset.Fields("说明") = Trim(Text7.Text).Adodc2.Recordset.UpdateEnd WithElsem = Form2.Adodc2.Recordset.Fields("数量").ValueIf Form2.Adodc2.Recordset.Fields("型号") = Trim(Text2.Text) ThenForm2.Adodc2.Recordset.Fields("数量") = Val(m) + Val(n)Form2.Adodc2.Recordset.UpdateEnd IfEnd IfDim X As IntegerX = MsgBox("产品入库登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload Me'Form2.ShowElseText1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text1.SetFocusEnd IfForm2.Frame2.Caption = "入库信息"Dim ZB As StringZB = "select * from 入库表 " 'where 品名 = '" & PM & "'"mandType = adCmdTextForm2.Adodc2.RecordSource = ZBForm2.Adodc2.RefreshEnd SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Text5.Text = ""Text6.Text = ""Text7.Text = ""Text1.SetFocusEnd SubPrivate Sub Command3_Click()Unload Me'Form2.ShowEnd Sub出库管理代码：Private Sub Command1_Click()If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" Then MsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"Exit SubElseIf Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Text2.SetFocusExit SubEnd IfIf Text2.Text = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Text2.SetFocusExit SubEnd IfAdodc1.RefreshAdodc1.Recordset.AddNew '添加Adodc1.Recordset.Fields("品名") = Trim(Combo1.Text) 'Trim(Text1.Text)Adodc1.Recordset.Fields("型号") = Trim(Combo2.Text) 'Trim(Text2.Text)Adodc1.Recordset.Fields("数量") = Trim(Text1.Text)Adodc1.Recordset.Fields("单位") = Trim(Combo3.Text) 'Trim(Text4.Text)Adodc1.Recordset.Fields("经手人") = Trim(Text2.Text)Adodc1.Recordset.Fields("出库日期") = DateAdodc1.Recordset.Fields("说明") = Trim(Text4.Text)Adodc1.Recordset.UpdateEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trim(Combo1.Text)n = Val(Text1.Text)pms = "select * from 库存表 where 品名='" & pm & "'"mandType = adCmdTextForm2.Adodc2.RecordSource = pmsForm2.Adodc2.Refreshm = Form2.Adodc2.Recordset.Fields("数量").ValueIf Form2.Adodc2.Recordset.Fields("型号") = Trim(Combo2.Text) ThenForm2.Adodc2.Recordset.Fields("数量") = Val(m) - Val(n)Form2.Adodc2.Recordset.UpdateEnd IfDim X As IntegerX = MsgBox("产品出库登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload Me'Form2.ShowEnd IfCombo1.Text = ""Combo2.Text = ""Combo3.Text = ""Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Form2.Frame2.Caption = "出库信息"Dim ZB As StringZB = "select * from 出库表 " 'where 品名 = '" & PM & "'" mandType = adCmdTextForm2.Adodc2.RecordSource = ZBForm2.Adodc2.RefreshEnd SubPrivate Sub Command2_Click()Combo1.Text = ""Combo2.Text = ""Combo3.Text = ""Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""End SubPrivate Sub Command3_Click()Unload Me'Form2.ShowEnd SubPrivate Sub Form_Load()Adodc2.RefreshAdodc2.Recordset.MoveFirstDo Until Adodc2.Recordset.EOFCombo2.AddItem Adodc2.Recordset.Fields("型号")Combo1.AddItem Adodc2.Recordset.Fields("品名")Combo3.AddItem Adodc2.Recordset.Fields("单位")Adodc2.Recordset.MoveNextLoopEnd Sub借出管理代码：Private Sub Command1_Click()If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" Then MsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"Exit SubElseIf Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Text1.SetFocusExit SubEnd IfIf Text2.Text = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Text2.SetFocusExit SubEnd IfAdodc1.RefreshAdodc1.Recordset.AddNew '添加Adodc1.Recordset.Fields("品名") = Trim(Combo1.Text) 'Trim(Text1.Text)Adodc1.Recordset.Fields("型号") = Trim(Combo2.Text) 'Trim(Text2.Text)Adodc1.Recordset.Fields("数量") = Trim(Text1.Text)Adodc1.Recordset.Fields("单位") = Trim(Combo3.Text) 'Trim(Text4.Text)Adodc1.Recordset.Fields("经手人") = Trim(Text2.Text)Adodc1.Recordset.Fields("借出人") = Trim(Text3.Text)Adodc1.Recordset.Fields("借出日期") = DateAdodc1.Recordset.Fields("说明") = Trim(Text4.Text)Adodc1.Recordset.UpdateEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trim(Combo1.Text)n = Val(Text1.Text)pms = "select * from 库存表 where 品名='" & pm & "'"mandType = adCmdTextForm2.Adodc2.RecordSource = pmsForm2.Adodc2.Refreshm = Form2.Adodc2.Recordset.Fields("数量").ValueIf Form2.Adodc2.Recordset.Fields("型号") = Trim(Combo2.Text) ThenForm2.Adodc2.Recordset.Fields("数量") = Val(m) - Val(n)Form2.Adodc2.Recordset.UpdateEnd IfDim X As IntegerX = MsgBox("产品借出登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload MeForm2.ShowEnd IfCombo1.Text = ""Combo2.Text = ""Combo3.Text = ""Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""Form2.Frame2.Caption = "借出信息"Dim ZB As StringZB = "select * from 借出表 " 'where 品名 = '" & PM & "'"mandType = adCmdTextForm2.Adodc2.RecordSource = ZBForm2.Adodc2.RefreshEnd SubPrivate Sub Command2_Click()Combo1.Text = ""Combo2.Text = ""Combo3.Text = ""Text1.Text = ""Text2.Text = ""Text3.Text = ""Text4.Text = ""End SubPrivate Sub Command3_Click()Unload MeForm2.ShowEnd Sub。

库存管理之用户登录及用户列表——VB代码

1、首页，用户登录界面'连接SQL数据库时必写语句Imports System.Data.SqlClientPublic Class Frm_UserloginPrivate Sub Bt_login_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Bt_login.ClickIf Txt_UserId.Text = ""ThenMsgBox("用户名不能为空,请输入用户名!", MsgBoxStyle.OkOnly, "温馨提示") Exit SubEnd IfIf Txt_Paw.Text = ""ThenMsgBox("密码不能为空,请输入密码!", MsgBoxStyle.OkOnly, "温馨提示")Exit SubEnd If'连接数据库Dim conn As New SqlConnection'conn.ConnectionString = "user id=sa;password=;database=test;data source=."连接SQL2000数据库的方法'连接SQL Server2005数据库的方法conn.ConnectionString = "server=.;integrated security=sspi;database=NO.4"conn.Open()Dim constr As String'判断输入的数据是否正确Dim UserName, password As StringUserName = Trim(Txt_UserId.Text)password = Trim(Txt_Paw.Text)constr = "select * from t1 where id='" & UserName & " 'and Psd='" & password & "'"Dim da As New SqlDataAdapter(constr, conn)Dim ds As New DataSetda.Fill(ds)If ds.Tables(0).Rows.Count >= 1 ThenMDIParent1.ShowDialog()Me.Hide()ElseMsgBox("用户名或密码错误", MsgBoxStyle.OkOnly, "温馨提示")Txt_UserId.Text = ""Txt_Paw.Text = ""Txt_Paw.Focus()Txt_UserId.Focus()End IfEnd SubPrivate Sub Bt_cancel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Bt_cancel.ClickTxt_UserId.Text = ""Txt_Paw.Text = ""Txt_Paw.Focus()Txt_UserId.Focus()End SubEnd ClassImports System.Data.SqlClientPublic Class Frm_yhlbDim conn As New SqlConnection()Dim flag As IntegerDim ds As New DataSetPrivate Sub Form2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load‘添加数据库中的数据到DGW控件中GroupBox1.Enabled = Falsebaocun.Enabled = Falsequxiao.Enabled = Falseconn.ConnectionString = "server=(local);integrated security=sspi;database=NO.4"conn.Open()Dim st As Stringst = "select * from t1"Dim da As New SqlDataAdapter(st, conn)Dim ds As New DataSetda.Fill(ds)DGW1.ColumnCount = ds.Tables(0).Columns.CountDGW1.RowCount = ds.Tables(0).Rows.Count'DGW1.ColumnCount = 4 '列'DGW1.RowCount = 4 '行For i = 0 To ds.Tables(0).Rows.Count - 1For j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Rows(i).Cells(j).Value = ds.Tables(0).Rows(i).ItemArray(j)Next jFor j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Columns(j).HeaderText = ds.Tables(0).Columns(j).ColumnNameNextNext iEnd SubFunction f_diaoyong(ByVal st As String) As Long'Dim st As String'st = "select * from t1"Dim da As New SqlDataAdapter(st, conn)Dim ds As New DataSetda.Fill(ds)DGW1.ColumnCount = ds.Tables(0).Columns.CountDGW1.RowCount = ds.Tables(0).Rows.Count'DGW1.ColumnCount = 4 '列'DGW1.RowCount = 4 '行For i = 0 To ds.Tables(0).Rows.Count - 1For j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Rows(i).Cells(j).Value = ds.Tables(0).Rows(i).ItemArray(j)Next jFor j = 0 To ds.Tables(0).Columns.Count - 1DGW1.Columns(j).HeaderText = ds.Tables(0).Columns(j).ColumnNameNextNext iEnd FunctionPrivate Sub tianjia_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tianjia.Clickflag = -1GroupBox1.Enabled = Truebaocun.Enabled = Truequxiao.Enabled = TrueTextBox1.Enabled = TrueTextBox2.Text = ""TextBox1.Text = ""TextBox1.Focus()TextBox3.Text = ""End SubPrivate Sub baocun_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles baocun.ClickIf flag = -1 ThenDim a, b, c As Stringa = Trim(TextBox1.Text)b = Trim(TextBox2.Text)c = Trim(TextBox3.Text)Dim str As StringDim da As New SqlDataAdapter("select * from t1", conn)da.Fill(ds)For i = 0 To ds.Tables(0).Rows.Count - 1str = Trim(ds.Tables(0).Rows(i).ItemArray(0))If Trim(TextBox1.Text) = str ThenMsgBox("对不起，你的ID重复，请重新输入！", MsgBoxStyle.OkOnly, "用户消息提示框")TextBox1.Text = ""TextBox1.Focus()Exit SubEnd IfNextDim stre = "Insert into t1 values('"& Trim(a) & " ',' "& Trim(b) & " ', ' "& Trim(c) & " ' )"Dim com As New SqlCommand(stre, conn)com.ExecuteNonQuery()ElseIf flag = 1 ThenDim name1, mima1, a1 As Stringname1 = TextBox2.Textmima1 = TextBox3.Texta1 = TextBox1.Texta1 = DGW1.SelectedRows(0).Cells(0).ValueDim stre = "update t1 set name= ' " & name1 & " ', psd= ' " & mima1 & " 'where id='" & a1 & " ' "Dim com As New SqlCommand(stre, conn)com.ExecuteNonQuery()End IfTextBox1.Text = ""TextBox1.Focus()TextBox2.Text = ""TextBox3.Text = ""baocun.Enabled = Falsequxiao.Enabled = FalseGroupBox1.Enabled = FalseCall f_diaoyong("select * from t1")End SubPrivate Sub quxiao_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles quxiao.ClickTextBox1.Text = ""TextBox1.Focus()TextBox2.Text = ""TextBox3.Text = ""DGW1.Enabled = Falsebaocun.Enabled = Falsequxiao.Enabled = FalseGroupBox1.Enabled = FalseEnd SubPrivate Sub xiugai_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles xiugai.Clickflag = 1TextBox1.Enabled = Falsebaocun.Enabled = Truequxiao.Enabled = TrueGroupBox1.Enabled = TrueTextBox1.Text = DGW1.SelectedRows(0).Cells(0).ValueTextBox2.Text = DGW1.SelectedRows(0).Cells(1).ValueTextBox3.Text = DGW1.SelectedRows(0).Cells(2).ValueEnd SubPrivate Sub tuichu_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tuichu.ClickEndEnd SubPrivate Sub shanchu_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles shanchu.ClickDim yh As Stringyh = TextBox1.Textyh = DGW1.SelectedRows(0).Cells(0).ValueDim stre = "delete from t1 where id='" & yh & " '"Dim com As New SqlCommand(stre, conn)com.ExecuteNonQuery()MsgBox("确定删除！", MsgBoxStyle.OkOnly, "提示信息")baocun.Enabled = Truequxiao.Enabled = TrueDGW1.Enabled = FalseCall f_diaoyong("select * from t1")End SubEnd Class。

仓库管理系统(VB+Access+源代码)

仓库管理系统项目的建立这是本人利用闲暇之余在上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。

由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。

此文可作供初学者们学习交流。

作者联系方式：E-mail最终运行效果打开软件出现如下登录界面输入系统预设用户名及密码（ 1 1 ）单击“登录”或单击“新用户”添加新用户进入如下主界面：建立工程1、创建标准EXE2、按“打开”3、添加MDI窗体——打开4、编辑菜单在空白处右击——点击“菜单编辑器”在“标题”里输入“系统”，在“名称”里输入“Sys”（注意此处不能为汉字）点击“下一个”再点击“”“确定”退到MDI界面点击“系统”——“退出”如下，然后编写代码。

代码如下：Private Sub Exit_Click()EndEnd Sub数据库的建立中可以创建Access数据库。

如下建立一个“用户表”的数据库，用来存放用户信息及一些出入库管理信息。

如下图单击“外接程序”再单击“可视化数据管理器”出现如图点击“文件”——“新建”——“Microsoft Access”——“Version MDB”输入数据库名，“保存”出现如下图在数据窗口中右击——“新建表”，最终如下往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。

登录界面窗口的建立最终界面如下：1、Adodc1的添加过程为：单击“工程”——“部件”出现下图所示，选择“控件”下的“Microsoft ADO Data Control （OLEDB）”单击“确定”在工具栏中会出现“”图标，单击它并拖动到相应位置即可。

其它元件不在一一说明。

2、本窗体代码如下：Private Sub Command1_Click() '“登录”、“确定”按钮 If = "确定" And = "取消" Then '如果为“确定”则添加新用户If = "" Then '提示用户输入用户名MsgBox "请输入用户名！", , "登录信息提示："Exit SubElse 'Dim usename As String '检测用户名是否已经存在Dim strS As Stringusename = TrimstrS = "select * from 用户登录信息表 where 用户名='" & usename & "'"= adCmdText= strSIf = False ThenMsgBox "您输入的用户已存在!", , "登录提示信息："= ""= ""= ""Exit SubEnd IfEnd IfIf = "" Then '提示用户密码不能为空 MsgBox "密码不能为空!", , "登录提示信息："Exit SubEnd IfIf = "" ThenMsgBox "请再次输入密码!", , "登录提示信息："Exit SubEnd IfIf <> ThenMsgBox "两次输入的密码不一致,请确认!", , "登录提示信息："= ""Exit SubElse'添加新用户"用户名") = Trim"密码") = TrimMsgBox ("添加新用户成功，现在您可以登陆系统了！")= False= False= "登录"= "退出"End IfElse '“登录”按钮，用户登录 Dim strSno As StringDim strSelect As StringstrSno = Trim '检测用户名是否存在strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'"= adCmdText= strSelectIf = True ThenMsgBox "用户名不存在，请重新输入！", , "登录提示信息："= ""= ""End IfIf "密码") = Trim Then '检测密码是否正确'Unload Me'MsgBox "登陆成功！", , "登录提示信息："ElseMsgBox "密码不正确，请重新输入！", , "登录提示信息："= ""End IfEnd IfEnd SubPrivate Sub Command2_Click() '“退出”或“取消”按钮 If = "取消" Then= False= False= "登录"= "退出"= ""= ""ElseEnd 'Unload MeEnd IfEnd SubPrivate Sub Command3_Click() '“新用户”按钮= True= True= ""= ""= ""= "确定"= "取消"End SubPrivate Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)= TrueEnd SubPrivate Sub Command3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)= FalseEnd SubPrivate Sub Form_Load()= False= FalseEnd SubPrivate Sub Timer1_Timer() '时间time1控件的time事件代码，用来'显示向左移动的欢迎字幕If + > 0 Then '当标签右边位置大于0时，标签向左移- 80Else '否则标签从头开始=End IfIf + > 0 Then- 80Else=End IfEnd Sub主界面窗体如下：代码：Private Sub AddNew_Click() = True= FalseEnd SubPrivate Sub CHKPMCHX_Click()= "出库信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 出库表 where 品名 = '" & pm & "'" = adCmdText= nCall InitGrid1End SubPrivate Sub CHKXHCHX_Click()= "出库信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)n = "select * from 出库表 where 型号 = '" & XH & "'" = adCmdText= nEnd SubPrivate Sub CKCZ_Click()'End SubPrivate Sub CKJSHR_Click()= "出库信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 出库表 where 经手人 = '" & JSHR & "'"= adCmdText= nCall InitGrid1End SubPrivate Sub CKSHJ_Click()= "出库信息"Dim CHKRQ As StringDim n As StringCHKRQ = InputBox("出库日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 出库表 where 出库日期 = '" & CHKRQ & "'"= adCmdText= nCall InitGrid1End SubPrivate Sub CKZCX_Click()= "出库信息"Dim ZB As StringZB = "select * from 出库表 "= adCmdText= ZBCall InitGrid1End SubPrivate Sub Command1_Click()If = "" Then '提示用户输入用户名MsgBox "请输入用户名！", , "登录信息提示："Exit SubElse 'Dim usename As String '检测用户名是否已经存在 Dim strS As Stringusename = TrimstrS = "select * from 用户登录信息表 where 用户名='" & usename & "'"= adCmdText= strSIf = False ThenMsgBox "您输入的用户已存在!", , "登录提示信息："= ""= ""= ""Exit SubEnd IfEnd IfIf = "" Then '提示用户密码不能为空MsgBox "密码不能为空!", , "登录提示信息："Exit SubEnd IfIf = "" ThenMsgBox "请再次输入密码!", , "登录提示信息："Exit SubEnd IfIf <> ThenMsgBox "两次输入的密码不一致,请确认!", , "登录提示信息："= ""= ""Exit SubElse'添加新用户"用户名") = Trim"密码") = TrimDim X As IntegerX = MsgBox("成功添加新用户，是否要重新登录!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbYes ThenUnload MeEnd If'MsgBox ("成功添加新用户！")' = False' = False' = "登录"' = "退出"End If= False= True= ""= "'"= ""'End SubPrivate Sub Command2_Click() = False= TrueEnd SubPrivate Sub CXDL_Click()'Unload MeEnd SubPrivate Sub Exit_Click()EndUnload Form1Unload Form2Unload Form3Unload Form4Unload Form5Unload Form6Unload Form7Unload Form8End SubPrivate Sub Form_Load()TextUserName = Trim Unload Form1= FalseCall InitGrid0= - 1060= - 560==End SubPrivate Sub GHCZ_Click()'End SubPrivate Sub GHPMCX_Click()= "归还信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 归还表 where 品名 = '" & pm & "'" = adCmdText= nCall InitGrid2End SubPrivate Sub GHRCX_Click()= "归还信息"Dim JCR As StringDim n As StringJCR = InputBox("归还人", "请输入", 0)n = "select * from 归还表 where 归还人 = '" & JCR & "'"= adCmdText= nCall InitGrid2End SubPrivate Sub GHSJCX_Click()= "归还信息"Dim JCRQ As StringDim n As StringJCRQ = InputBox("归还日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 归还表 where 归还日期 = '" & JCRQ & "'"= adCmdText= nCall InitGrid2End SubPrivate Sub GHXHCX_Click()= "归还信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)n = "select * from 归还表 where 型号 = '" & XH & "'" = adCmdText= nCall InitGrid2End SubPrivate Sub GHZCX_Click()= "归还信息"Dim ZB As StringZB = "select * from 归还表 "= adCmdText= ZBCall InitGrid2End SubPrivate Sub JCCZ_Click()'End SubPrivate Sub JCHPMCHX_Click()= "借出信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 借出表 where 品名 = '" & pm & "'"= adCmdText= nCall InitGrid2End SubPrivate Sub JCHXHCHX_Click()= "借出信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)n = "select * from 借出表 where 型号 = '" & XH & "'"= adCmdText= nCall InitGrid2End SubPrivate Sub JCRCX_Click()= "借出信息"Dim JCR As StringDim n As StringJCR = InputBox("借出人", "请输入", 0)n = "select * from 借出表 where 借出人 = '" & JCR & "'" = adCmdText= nCall InitGrid2End SubPrivate Sub JCSHJCX_Click()= "借出信息"Dim JCRQ As StringDim n As StringJCRQ = InputBox("借出日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 借出表 where 借出日期 = '" & JCRQ & "'"= adCmdText= nCall InitGrid2End SubPrivate Sub JCZCX_Click()= "借出信息"Dim ZB As StringZB = "select * from 借出表 "= adCmdText= ZBCall InitGrid2End SubPrivate Sub JSHRCHX_Click()= "归还信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 归还表 where 经手人 = '" & JSHR & "'" = adCmdText= nCall InitGrid2End SubPrivate Sub JSHRCX_Click()= "借出信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 借出表 where 经手人 = '" & JSHR & "'" = adCmdText= nCall InitGrid2End SubPrivate Sub PMCX_Click()= "库存信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)n = "select * from 库存表 where 品名 = '" & pm & "'"= adCmdText= nCall InitGrid0End SubPrivate Sub RKCZ_Click()'End SubPrivate Sub RKJSHR_Click()= "入库信息"Dim JSHR As StringDim n As StringJSHR = InputBox("经手人", "请输入", 0)n = "select * from 入库表 where 经手人 = '" & JSHR & "'" = adCmdText= nCall InitGrid1End SubPrivate Sub RKPMCHX_Click()= "入库信息"Dim pm As StringDim n As Stringpm = InputBox("产品名", "请输入", 0)If Len(pm) > 0 Thenn = "select * from 入库表 where 品名 = '" & pm & "'" = adCmdText= nEnd IfCall InitGrid1End SubPrivate Sub RKSHJ_Click()= "入库信息"Dim RKRQ As StringDim n As StringRKRQ = InputBox("入库日期，格式为：月/日/年如：12/1/2011", "请输入", 0) n = "select * from 入库表 where 入库日期 = '" & RKRQ & "'"= adCmdText= nCall InitGrid1End SubPrivate Sub RKXHCHX_Click()= "入库信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)If Len(XH) > 0 Thenn = "select * from 入库表 where 型号 = '" & XH & "'"= adCmdText= nEnd IfCall InitGrid1End SubPrivate Sub RKZCX_Click()= "入库信息"Dim ZB As StringZB = "select * from 入库表 "= adCmdText= ZBCall InitGrid1End SubPrivate Sub Timer1_Timer()If + > 0 Then '当标签右边位置大于0时，标签向左移- 80Else '否则标签从头开始 =End IfIf + > 0 Then- 80Else=End IfIf + > 0 Then- 80Else=End IfIf + > 0 Then- 80Else=End IfEnd SubPrivate Sub XGMM_Click()'End SubPrivate Sub XHCX_Click()= "库存信息"Dim XH As StringDim n As StringXH = InputBox("产品型号", "请输入", 0)If Len(XH) > 0 Then 'And Val(XH) <> 0n = "select * from 库存表 where 型号 = '" & XH & "'" = adCmdText= nEnd IfCall InitGrid0End SubPrivate Sub ZB_Click()= "库存信息"Dim ZB As String'Dim N As String'PM = InputBox("产品名", "请输入", 0)ZB = "select * from 库存表 " 'where 品名 = '" & PM & "'" = adCmdText= ZBCall InitGrid0End SubPrivate Sub InitGrid0()With DataGrid1.Columns(0).Width = 1600.Columns(1).Width = 2200.Columns(2).Width = 2200.Columns(3).Width = 1000.Columns(4).Width = 1000.Columns(5).Width = 4000End WithEnd SubPrivate Sub InitGrid1()With DataGrid1.Columns(0).Width = 800.Columns(1).Width = 1600.Columns(2).Width = 1600.Columns(3).Width = 800.Columns(4).Width = 800.Columns(5).Width = 1000.Columns(6).Width = 800.Columns(7).Width = 4000End WithEnd SubPrivate Sub InitGrid2()With DataGrid1'.Columns(0).Caption = "学号" ' .Columns(1).Caption = "课程名" '.Columns(2).Caption = "学分" ' .Columns(3).Caption = "成绩" '设置DtgCond的列宽.Columns(0).Width = 800.Columns(1).Width = 1600.Columns(2).Width = 1600.Columns(3).Width = 800.Columns(4).Width = 800.Columns(5).Width = 800.Columns(6).Width = 1000.Columns(7).Width = 800.Columns(8).Width = 4000End WithEnd Sub用户重新登录界面代码：Private Sub Command1_Click()Dim strSno As StringDim strSelect As StringstrSno = Trim '检测用户名是否存在 strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'"= adCmdText= strSelectIf = True ThenMsgBox "用户名不存在，请重新输入！", , "登录提示信息："= ""= ""Exit SubEnd IfIf "密码") = Trim Then '检测密码是否正确Unload Me'MsgBox "登陆成功！", , "登录提示信息："ElseMsgBox "密码不正确，请重新输入！", , "登录提示信息：" = ""End IfEnd SubPrivate Sub Command2_Click()Unload MeEnd Sub修改用户密码界面代码：Private Sub Command1_Click()If Trim <> ThenMsgBox "用户名不正确，请确认！", , "信息提示！"= ""Exit SubElseDim name As StringDim names As Stringname = Trimnames = "select * from 用户登录信息表 where 用户名='" & name & "'" = adCmdText= namesIf = "" ThenMsgBox "请输入旧密码!", , "信息提示！"Exit SubEnd IfIf "密码") <> Trim ThenMsgBox "旧密码不正确，请确认!", , "信息提示！"= ""Exit SubEnd IfIf = "" ThenMsgBox "请输入新密码!", , "信息提示！"Exit SubEnd IfIf = "" ThenMsgBox "请再次输入新密码!", , "信息提示！"Exit SubEnd IfIf Trim <> Trim ThenMsgBox "两次输入的新密码不一致!", , "信息提示！" = ""= ""Exit SubElse"密码") = TrimMsgBox ("密码修改成功！")Unload Me'End IfEnd IfEnd SubPrivate Sub Command2_Click()Unload Me'End Sub入库管理代码：Private Sub Command1_Click()If = "" And = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!" Exit SubElseIf = "" And = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Exit SubEnd IfIf = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Exit SubEnd If'添加 "品名") = Trim"型号") = Trim"数量") = Trim"单位") = Trim"经手人") = Trim"入库日期") = Date"说明") = TrimEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trimn = Valpms = "select * from 库存表 where 品名='" & pm & "'"= adCmdText= pmsIf ThenWith Form2. ."品名") = Trim."型号") = Trim."数量") = Trim."单位") = Trim."说明") = Trim. End WithElsem = "数量").ValueIf "型号") = Trim Then"数量") = Val(m) + Val(n)End IfEnd IfDim X As IntegerX = MsgBox("产品入库登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload Me'Else= ""= ""= ""= ""= ""= ""= ""End If= "入库信息"Dim ZB As StringZB = "select * from 入库表 " 'where 品名 = '" & PM & "'"= adCmdText= ZBSubPrivate Sub Command2_Click()= ""= ""= ""= ""= ""= ""End SubPrivate Sub Command3_Click()Unload Me'End Sub出库管理代码：Private Sub Command1_Click()If = "" And = "" Then ' = "" And = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!" Exit SubIf = "" And = "" Then ' = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Exit SubEnd IfIf = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Exit SubEnd If'添加"品名") = Trim 'Trim"型号") = Trim 'Trim"数量") = Trim"单位") = Trim 'Trim"经手人") = Trim"出库日期") = Date"说明") = TrimEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trimn = Valpms = "select * from 库存表 where 品名='" & pm & "'"= adCmdText= pmsm = "数量").ValueIf "型号") = Trim Then"数量") = Val(m) - Val(n)End IfDim X As IntegerX = MsgBox("产品出库登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload Me'End If= ""= ""= ""= ""= ""= ""= ""= "出库信息"Dim ZB As StringZB = "select * from 出库表 " 'where 品名 = '" & PM & "'"= adCmdText= ZBSubPrivate Sub Command2_Click()= ""= ""= ""= ""= ""= ""= ""End SubPrivate Sub Command3_Click() Unload Me'End SubPrivate Sub Form_Load()Do Until "型号") "品名")"单位")LoopEnd Sub借出管理代码：Private Sub Command1_Click()If = "" And = "" Then ' = "" And = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!" Exit SubElseIf = "" And = "" Then ' = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Exit SubEnd IfIf = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Exit SubEnd If'添加"品名") = Trim 'Trim"型号") = Trim 'Trim"数量") = Trim"单位") = Trim 'Trim"经手人") = Trim"借出人") = Trim"借出日期") = Date"说明") = TrimEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trimn = Valpms = "select * from 库存表 where 品名='" & pm & "'"= adCmdText= pmsm = "数量").ValueIf "型号") = Trim Then"数量") = Val(m) - Val(n)End IfDim X As IntegerX = MsgBox("产品借出登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload MeEnd If= ""= ""= ""= ""= ""= ""= ""= "借出信息"Dim ZB As StringZB = "select * from 借出表 " 'where 品名 = '" & PM & "'" = adCmdText= ZBSubPrivate Sub Command2_Click()= ""= ""= ""= ""= ""= ""= ""End SubPrivate Sub Command3_Click()Unload MeEnd SubPrivate Sub Form_Load()Do Until "品名")"型号")"单位")LoopEnd Sub归还管理代码：Private Sub Command1_Click()If = "" And = "" Then ' = "" And = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!" Exit SubElseIf = "" And = "" Then ' = "" ThenMsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Exit SubEnd IfIf = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Exit SubEnd IfIf = "" ThenMsgBox "请输入归还人姓名!", vbCritical, "提示信息!"Exit SubEnd If'添加 "品名") = Trim 'Trim"型号") = Trim 'Trim"数量") = Trim"单位") = Trim 'Trim"经手人") = Trim"归还人") = Trim"归还日期") = Date"说明") = TrimEnd IfDim pm As StringDim pms As StringDim n As StringDim m As Stringpm = Trimn = Valpms = "select * from 库存表 where 品名='" & pm & "'"= adCmdText= pmsm = "数量").ValueIf "型号") = Trim Then"数量") = Val(m) + Val(n)End IfDim X As IntegerX = MsgBox("产品归还登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!") If X = vbNo ThenUnload MeEnd If= ""= ""= ""= ""= ""= ""= ""= "归还信息"Dim ZB As StringZB = "select * from 归还表 " 'where 品名 = '" & PM & "'"= adCmdText= ZBSubPrivate Sub Command2_Click()= ""= ""= ""= ""= ""= ""= ""End SubPrivate Sub Command3_Click() Unload MeEnd SubPrivate Sub Form_Load()' Dim i As String' i = 0'' ' Do Until ' "品名") ' "型号")' "单位")' ' i = i + 1' LoopCall pmEnd SubPrivate Sub pm()Dim i As VariantDim j As VariantDim k As VariantDim a As VariantDim b As VariantDim c As VariantDim s As VariantDim D As Varianti = 0j = 0Do Until a = a + "," + "品名")b = b + "," + "型号")b = b + "," + "单位")i = i + 1LoopD = Split(a, ",")If j < i Thens = D(2)s'k = 0'If k < j And D(k) <> D(j) Then'If D(k) <> D(j) Then' D(j)' k = k + 1' Else' k = k + 1'End If'End Ifj = j + 1End If= s 'a + "," + D(2) + D(1) '+ " " + Val(i) + " " + Val(j) + " " + Val(k) = j' D(1)End Sub。

仓库管理系统VBAccess源代码

仓库管理系统V B A c c e s s源代码 SANY标准化小组 #QS8QHH-HHGX8Q8-GNHHJ8-HHMHGN#仓库管理系统项目的建立这是本人利用闲暇之余在VB6.0上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。

由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。

此文可作供初学者们学习交流。

作者联系方式：E-mail 最终运行效果打开软件出现如下登录界面输入系统预设用户名及密码（11）单击“登录”或单击“新用户”添加新用户进入如下主界面：建立工程1、创建标准EXE2、按“打开”3、添加MDI窗体——打开4、编辑菜单在空白处右击——点击“菜单编辑器”在“标题”里输入“系统”，在“名称”里输入“Sys”（注意此处不能为汉字）点击“下一个”再点击“”“确定”退到MDI界面点击“系统”——“退出”如下，然后编写代码。

代码如下：PrivateSubExit_Click()EndEndSub数据库的建立VB6.0中可以创建Access数据库。

如下建立一个“用户表”的数据库，用来存放用户信息及一些出入库管理信息。

登录界面窗口的建立最终界面如下：1、Adodc1的添加过程为：单击“工程”——“部件”出现下图所示，选择“控件”下的“MicrosoftADODataControl6.0（OLEDB）”单击“确定”在工具栏中会出现“”图标，单击它并拖动到相应位置即可。

其它元件不在一一说明。

2、本窗体代码如下：PrivateSubCommand1_Click()'“登录”、“确定”按钮IfCommand1.Caption="确定"AndCommand2.Caption="取消"Then'如果为“确定”则添加新用户MsgBox"请输入用户名！",,"登录信息提示："ExitSubElse'DimusenameAsString'检测用户名是否已经存在DimstrSAsStringusename=Trim(Text1.Text)strS="select*from用户登录信息表where用户名='"&usename&"'" mandType=adCmdTextAdodc1.RecordSource=strSAdodc1.RefreshMsgBox"您输入的用户已存在!",,"登录提示信息："Text1.Text=""Text2.Text=""Text3.Text=""Text1.SetFocusExitSubEndIfEndIfIfText2.Text=""Then'提示用户密码不能为空MsgBox"密码不能为空!",,"登录提示信息："Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox"请再次输入密码!",,"登录提示信息："Text3.SetFocusExitSubEndIfIfText2.Text<>Text3.TextThenMsgBox"两次输入的密码不一致,请确认!",,"登录提示信息：" Text2.Text=""Text3.Text=""Text2.SetFocusExitSubElseMsgBox("添加新用户成功，现在您可以登陆系统了！")Label3.Visible=FalseText3.Visible=FalseCommand1.Caption="登录"Command2.Caption="退出"EndIfElse'“登录”按钮，用户登录DimstrSnoAsStringDimstrSelectAsStringstrSno=Trim(Text1.Text)'检测用户名是否存在strSelect="select密码from用户登录信息表where用户名='"&strSno&"'" mandType=adCmdTextAdodc1.RecordSource=strSelectAdodc1.RefreshMsgBox"用户名不存在，请重新输入！",,"登录提示信息："Text1.Text=""Text2.Text=""Text1.SetFocusExitSubEndIfForm1.Hide'UnloadMeForm2.Show'MsgBox"登陆成功！",,"登录提示信息："ElseMsgBox"密码不正确，请重新输入！",,"登录提示信息："Text2.Text=""Text2.SetFocusEndIfEndIfEndSubPrivateSubCommand2_Click()'“退出”或“取消”按钮IfCommand2.Caption="取消"ThenLabel3.Visible=FalseText3.Visible=FalseCommand1.Caption="登录"Command2.Caption="退出"Text1.Text=""Text2.Text=""Text1.SetFocusElseEnd'UnloadMeEndIfEndSubPrivateSubCommand3_Click()'“新用户”按钮Label3.Visible=TrueText3.Visible=TrueText1.Text=""Text2.Text=""Text3.Text=""Command1.Caption="确定"Command2.Caption="取消"Text1.SetFocusEndSubPrivateSubCommand3_MouseDown(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle) Label6.Visible=TrueEndSubPrivateSubCommand3_MouseUp(ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle) Label6.Visible=FalseEndSubPrivateSubForm_Load()Label3.Visible=FalseText3.Visible=FalseEndSubPrivateSubTimer1_Timer()'时间time1控件的time事件代码，用来'显示向左移动的欢迎字幕IfLabel4.Left+Label4.Width>0Then'当标签右边位置大于0时，标签向左移Else'否则标签从头开始Label4.Left=Form1.ScaleWidthEndIfIfLabel5.Left+Label5.Width>0ThenElseLabel5.Left=Form1.ScaleWidthEndIfEndSub主界面窗体如下：代码：PrivateSubAddNew_Click()Frame1.Visible=TrueFrame2.Visible=FalseEndSubPrivateSubCHKPMCHX_Click()Frame2.Caption="出库信息"DimpmAsStringDimnAsStringpm=InputBox("产品名","请输入",0)n="select*from出库表where品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubCHKXHCHX_Click()Frame2.Caption="出库信息"DimXHAsStringDimnAsStringXH=InputBox("产品型号","请输入",0)n="select*from出库表where型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndSubPrivateSubCKCZ_Click()'Form2.HideForm6.ShowEndSubPrivateSubCKJSHR_Click()Frame2.Caption="出库信息"DimJSHRAsStringDimnAsStringJSHR=InputBox("经手人","请输入",0)n="select*from出库表where经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubCKSHJ_Click()Frame2.Caption="出库信息"DimCHKRQAsStringDimnAsStringCHKRQ=InputBox("出库日期，格式为：月/日/年如：12/1/2011","请输入",0) n="select*from出库表where出库日期='"&CHKRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubCKZCX_Click()Frame2.Caption="出库信息"DimZBAsStringZB="select*from出库表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid1EndSubPrivateSubCommand1_Click()IfText1.Text=""Then'提示用户输入用户名MsgBox"请输入用户名！",,"登录信息提示："ExitSubElse'DimusenameAsString'检测用户名是否已经存在DimstrSAsStringusename=Trim(Text1.Text)strS="select*from用户登录信息表where用户名='"&usename&"'"mandType=adCmdTextAdodc1.RecordSource=strSAdodc1.RefreshMsgBox"您输入的用户已存在!",,"登录提示信息："Text1.Text=""Text2.Text=""Text3.Text=""Text1.SetFocusExitSubEndIfEndIfIfText2.Text=""Then'提示用户密码不能为空MsgBox"密码不能为空!",,"登录提示信息："Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox"请再次输入密码!",,"登录提示信息："Text3.SetFocusExitSubEndIfIfText2.Text<>Text3.TextThenMsgBox"两次输入的密码不一致,请确认!",,"登录提示信息："Text2.Text=""Text3.Text=""Text2.SetFocusExitSubElseeDimXAsIntegerX=MsgBox("成功添加新用户，是否要重新登录!",vbYesNo+vbQuestion+vbDefaultButton1,"提示信息!") IfX=vbYesThenUnloadMeForm3.ShowEndIf'MsgBox("成功添加新用户！")'Label3.Visible=False'Text3.Visible=False'Command1.Caption="登录"'Command2.Caption="退出"EndIfFrame1.Visible=FalseFrame2.Visible=TrueText1.Text=""Text2.Text="'"Text3.Text=""'Form3.ShowEndSubPrivateSubCommand2_Click() Frame1.Visible=FalseFrame2.Visible=TrueEndSubPrivateSubCXDL_Click()Form3.Show'UnloadMeEndSubPrivateSubExit_Click()EndUnloadForm1UnloadForm2UnloadForm3UnloadForm4UnloadForm5UnloadForm6UnloadForm7UnloadForm8EndSubPrivateSubForm_Load() UnloadForm1Frame1.Visible=False CallInitGrid0Me.Height=MDIForm1.Height-1060 Me.Width=MDIForm1.Width-560 Me.Top=MDIForm1.TopMe.Left=MDIForm1.LeftEndSubPrivateSubGHCZ_Click()'Form2.HideForm8.ShowEndSubFrame2.Caption="归还信息"DimpmAsStringDimnAsStringpm=InputBox("产品名","请输入",0)n="select*from归还表where品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubGHRCX_Click()Frame2.Caption="归还信息"DimJCRAsStringDimnAsStringJCR=InputBox("归还人","请输入",0)n="select*from归还表where归还人='"&JCR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubGHSJCX_Click()Frame2.Caption="归还信息"DimJCRQAsStringDimnAsStringJCRQ=InputBox("归还日期，格式为：月/日/年如：12/1/2011","请输入",0) n="select*from归还表where归还日期='"&JCRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubGHXHCX_Click()Frame2.Caption="归还信息"DimXHAsStringDimnAsStringXH=InputBox("产品型号","请输入",0)n="select*from归还表where型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubFrame2.Caption="归还信息"DimZBAsStringZB="select*from归还表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCCZ_Click()'Form2.HideForm7.ShowEndSubPrivateSubJCHPMCHX_Click()Frame2.Caption="借出信息"DimpmAsStringDimnAsStringpm=InputBox("产品名","请输入",0)n="select*from借出表where品名='"&pm&"'" mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCHXHCHX_Click()Frame2.Caption="借出信息"DimXHAsStringDimnAsStringXH=InputBox("产品型号","请输入",0)n="select*from借出表where型号='"&XH&"'" mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCRCX_Click()Frame2.Caption="借出信息"DimJCRAsStringDimnAsStringJCR=InputBox("借出人","请输入",0)n="select*from借出表where借出人='"&JCR&"'" mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCSHJCX_Click()Frame2.Caption="借出信息"DimJCRQAsStringDimnAsStringJCRQ=InputBox("借出日期，格式为：月/日/年如：12/1/2011","请输入",0) n="select*from借出表where借出日期='"&JCRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJCZCX_Click()Frame2.Caption="借出信息"DimZBAsStringZB="select*from借出表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid2EndSubPrivateSubJSHRCHX_Click()Frame2.Caption="归还信息"DimJSHRAsStringDimnAsStringJSHR=InputBox("经手人","请输入",0)n="select*from归还表where经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubJSHRCX_Click()Frame2.Caption="借出信息"DimJSHRAsStringDimnAsStringJSHR=InputBox("经手人","请输入",0)n="select*from借出表where经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid2EndSubPrivateSubPMCX_Click()Frame2.Caption="库存信息"DimpmAsStringDimnAsStringpm=InputBox("产品名","请输入",0)n="select*from库存表where品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid0EndSubPrivateSubRKCZ_Click()'Form2.HideForm5.ShowEndSubPrivateSubRKJSHR_Click()Frame2.Caption="入库信息"DimJSHRAsStringDimnAsStringJSHR=InputBox("经手人","请输入",0)n="select*from入库表where经手人='"&JSHR&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubRKPMCHX_Click()Frame2.Caption="入库信息"DimpmAsStringDimnAsStringpm=InputBox("产品名","请输入",0)IfLen(pm)>0Thenn="select*from入库表where品名='"&pm&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndIfCallInitGrid1EndSubPrivateSubRKSHJ_Click()Frame2.Caption="入库信息"DimRKRQAsStringDimnAsStringRKRQ=InputBox("入库日期，格式为：月/日/年如：12/1/2011","请输入",0)n="select*from入库表where入库日期='"&RKRQ&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshCallInitGrid1EndSubPrivateSubRKXHCHX_Click()Frame2.Caption="入库信息"DimXHAsStringDimnAsStringXH=InputBox("产品型号","请输入",0)IfLen(XH)>0Thenn="select*from入库表where型号='"&XH&"'"mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndIfCallInitGrid1EndSubPrivateSubRKZCX_Click()Frame2.Caption="入库信息"DimZBAsStringZB="select*from入库表"mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid1EndSubPrivateSubTimer1_Timer()IfLabel4.Left+Label4.Width>0Then'当标签右边位置大于0时，标签向左移Else'否则标签从头开始Label4.Left=Form2.ScaleWidthEndIfIfLabel5.Left+Label5.Width>0ThenElseLabel5.Left=Form2.ScaleWidthEndIfIfLabel6.Left+Label6.Width>0ThenElseLabel6.Left=Form2.ScaleWidthEndIfIfLabel7.Left+Label7.Width>0ThenElseLabel7.Left=Form2.ScaleWidthEndIfEndSubPrivateSubXGMM_Click()'Form2.HideForm4.ShowEndSubPrivateSubXHCX_Click()Frame2.Caption="库存信息"DimXHAsStringDimnAsStringXH=InputBox("产品型号","请输入",0)IfLen(XH)>0Then'AndVal(XH)<>0n="select*from库存表where型号='"&XH&"'" mandType=adCmdTextAdodc2.RecordSource=nAdodc2.RefreshEndIfCallInitGrid0EndSubPrivateSubZB_Click()Frame2.Caption="库存信息"DimZBAsString'DimNAsString'PM=InputBox("产品名","请输入",0)ZB="select*from库存表"'where品名='"&PM&"'" mandType=adCmdTextAdodc2.RecordSource=ZBAdodc2.RefreshCallInitGrid0EndSubPrivateSubInitGrid0()WithDataGrid1.Columns(0).Width=1600.Columns(1).Width=2200.Columns(2).Width=2200.Columns(3).Width=1000.Columns(4).Width=1000.Columns(5).Width=4000EndWithEndSubPrivateSubInitGrid1()WithDataGrid1.Columns(0).Width=800.Columns(1).Width=1600.Columns(2).Width=1600.Columns(3).Width=800.Columns(4).Width=800.Columns(5).Width=1000.Columns(6).Width=800.Columns(7).Width=4000EndWithEndSubPrivateSubInitGrid2()WithDataGrid1'.Columns(0).Caption="学号"'.Columns(1).Caption="课程名"'.Columns(2).Caption="学分"'.Columns(3).Caption="成绩"'设置DtgCond的列宽.Columns(0).Width=800.Columns(1).Width=1600.Columns(2).Width=1600.Columns(3).Width=800.Columns(4).Width=800.Columns(5).Width=800.Columns(6).Width=1000.Columns(7).Width=800.Columns(8).Width=4000EndWithEndSub用户重新登录界面代码：PrivateSubCommand1_Click()DimstrSnoAsStringDimstrSelectAsStringstrSno=Trim(Text1.Text)'检测用户名是否存在strSelect="select密码from用户登录信息表where用户名='"&strSno&"'" mandType=adCmdTextAdodc1.RecordSource=strSelectAdodc1.RefreshMsgBox"用户名不存在，请重新输入！",,"登录提示信息："Text1.Text=""Text2.Text=""Text1.SetFocusEndIfUnloadMeForm2.Show'MsgBox"登陆成功！",,"登录提示信息："ElseMsgBox"密码不正确，请重新输入！",,"登录提示信息："Text2.Text=""Text2.SetFocusEndIfEndSubPrivateSubCommand2_Click()UnloadMeForm2.ShowEndSub修改用户密码界面代码：PrivateSubCommand1_Click()IfTrim(Text1.Text)<>Form2.TextUserNameThenMsgBox"用户名不正确，请确认！",,"信息提示！"Text1.Text=""Text1.SetFocusExitSubElseDimnameAsStringDimnamesAsStringname=Trim(Text1.Text)names="select*from用户登录信息表where用户名='"&name&"'" mandType=adCmdTextAdodc1.RecordSource=namesAdodc1.RefreshIfText2.Text=""ThenMsgBox"请输入旧密码!",,"信息提示！"Text2.SetFocusExitSubEndIfMsgBox"旧密码不正确，请确认!",,"信息提示！"Text2.Text=""Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox"请输入新密码!",,"信息提示！"Text3.SetFocusEndIfIfText4.Text=""ThenMsgBox"请再次输入新密码!",,"信息提示！"Text4.SetFocusExitSubEndIfIfTrim(Text3.Text)<>Trim(Text4.Text)ThenMsgBox"两次输入的新密码不一致!",,"信息提示！"Text3.Text=""Text4.Text=""Text3.SetFocusExitSubElseMsgBox("密码修改成功！")UnloadMe'Form2.ShowEndIfEndIfEndSubPrivateSubCommand2_Click()UnloadMe'Form2.ShowEndSub入库管理代码：PrivateSubCommand1_Click()IfText1.Text=""AndText2.Text=""ThenMsgBox"“品名”和“型号”不能同时为空，必须输入其中一项!",,"提示信息!" ExitSubText1.SetFocusElseIfText3.Text=""AndText4.Text=""ThenMsgBox"请输入产品“数量”或“单位”之一!",,"提示信息!"Text3.SetFocusExitSubEndIfIfText5.Text=""ThenMsgBox"请经手人签名!",vbCritical,"提示信息!"Text5.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Text1.Text)n=Val(Text3.Text)pms="select*from库存表where品名='"&pm&"'"WithForm2EndWithElseEndIfEndIfDimXAsIntegerX=MsgBox("产品入库登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1,"提示信息!") IfX=vbNoThenUnloadMe'Form2.ShowElseText1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""Text5.Text=""Text6.Text=""Text7.Text=""Text1.SetFocusEndIfDimZBAsStringZB="select*from入库表"'where品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""Text5.Text=""Text6.Text=""Text7.Text=""Text1.SetFocusEndSubPrivateSubCommand3_Click()UnloadMe'Form2.ShowEndSub出库管理代码：PrivateSubCommand1_Click()IfCombo1.Text=""AndCombo2.Text=""Then'text1.Text=""AndText2.Text=""ThenMsgBox"“品名”和“型号”不能同时为空，必须输入其中一项!",,"提示信息!"ExitSubElseIfText1.Text=""AndCombo3.Text=""Then'Text4.Text=""ThenMsgBox"请输入产品“数量”或“单位”之一!",,"提示信息!"Text2.SetFocusExitSubEndIfIfText2.Text=""ThenMsgBox"请经手人签名!",vbCritical,"提示信息!"Text2.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Combo1.Text)n=Val(Text1.Text)pms="select*from库存表where品名='"&pm&"'"EndIfDimXAsIntegerX=MsgBox("产品出库登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1,"提示信息!") IfX=vbNoThenUnloadMe'Form2.ShowEndIfCombo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""DimZBAsStringZB="select*from出库表"'where品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""EndSubPrivateSubCommand3_Click()UnloadMe'Form2.ShowEndSubPrivateSubForm_Load()Adodc2.RefreshLoopEndSub借出管理代码：PrivateSubCommand1_Click()IfCombo1.Text=""AndCombo2.Text=""Then'text1.Text=""AndText2.Text=""Then MsgBox"“品名”和“型号”不能同时为空，必须输入其中一项!",,"提示信息!" ExitSubElseIfText1.Text=""AndCombo3.Text=""Then'Text4.Text=""ThenMsgBox"请输入产品“数量”或“单位”之一!",,"提示信息!"Text1.SetFocusExitSubEndIfIfText2.Text=""ThenMsgBox"请经手人签名!",vbCritical,"提示信息!"Text2.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Combo1.Text)n=Val(Text1.Text)pms="select*from库存表where品名='"&pm&"'"EndIfDimXAsIntegerX=MsgBox("产品借出登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1,"提示信息!") IfX=vbNoThenUnloadMeForm2.ShowEndIfCombo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""DimZBAsStringZB="select*from借出表"'where品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""EndSubPrivateSubCommand3_Click()UnloadMeForm2.ShowEndSubPrivateSubForm_Load()Adodc2.RefreshLoopEndSub归还管理代码：PrivateSubCommand1_Click()IfCombo1.Text=""AndCombo2.Text=""Then'text1.Text=""AndText2.Text=""ThenMsgBox"“品名”和“型号”不能同时为空，必须输入其中一项!",,"提示信息!"ExitSubElseIfText1.Text=""AndCombo3.Text=""Then'Text4.Text=""ThenMsgBox"请输入产品“数量”或“单位”之一!",,"提示信息!"Text1.SetFocusExitSubEndIfIfText2.Text=""ThenMsgBox"请经手人签名!",vbCritical,"提示信息!"Text2.SetFocusExitSubEndIfIfText3.Text=""ThenMsgBox"请输入归还人姓名!",vbCritical,"提示信息!"Text3.SetFocusExitSubEndIfAdodc1.RefreshEndIfDimpmAsStringDimpmsAsStringDimnAsStringDimmAsStringpm=Trim(Combo1.Text)n=Val(Text1.Text)pms="select*from库存表where品名='"&pm&"'"EndIfDimXAsIntegerX=MsgBox("产品归还登记成功，是否继续添加产品!",vbYesNo+vbQuestion+vbDefaultButton1,"提示信息!") IfX=vbNoThenUnloadMeForm2.ShowEndIfCombo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""DimZBAsStringZB="select*from归还表"'where品名='"&PM&"'"EndSubPrivateSubCommand2_Click()Combo1.Text=""Combo2.Text=""Combo3.Text=""Text1.Text=""Text2.Text=""Text3.Text=""Text4.Text=""EndSubPrivateSubCommand3_Click()UnloadMeForm2.ShowEndSubPrivateSubForm_Load()'DimiAsString'i=0'Adodc2.Refresh'i=i+1'LoopCallpmEndSubPrivateSubpm()DimiAsVariantDimjAsVariantDimkAsVariantDimaAsVariantDimbAsVariantDimcAsVariantDimsAsVariantDimDAsVarianti=0j=0Adodc2.Refreshi=i+1LoopD=Split(a,",")Ifj<iThens=D(2)Combo1.AddItems'k=0'Ifk<jAndD(k)<>D(j)Then'IfD(k)<>D(j)Then'Combo1.AddItemD(j)'k=k+1'Else'k=k+1'EndIf'EndIfj=j+1EndIfText5.Text=s'a+","+D(2)+D(1)'+""+Val(i)+""+Val(j)+""+Val(k) Text6.Text=j'Combo1.AddItemD(1) EndSub。

仓库管理系统(VB+Access+源代码)

精心整理仓库管理系统项目的建立这是本人利用闲暇之余在VB6.0上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。

由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。

此文可作供初学者们学习交流。

作者联系方式：E-mail1、2、3、4、EndVB6.0中可以创建Access数据库。

如下建立一个“用户表”的数据库，用来存放用户信息及一些出入库管理信息。

如下图单击“外接程序”再单击“可视化数据管理器”出现如图点击“文件”——“新建”——“Microsoft Access”——“Version 2.0 MDB”输入数据库名，“保存”出现如下图在数据窗口中右击——“新建表”，最终如下往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。

其它元件不在一一说明。

VB物流管理系统设计(源代码及全套资料)

货运物流管理系统摘要现代物流作为一种先进的组织方式和管理技术，被广泛认为是企业在降低物资消耗、提高劳动生产效率以外的重要利润源泉，在国民经济和社会发展中发挥着重要作用。

加快中国现代物流的发展，对于优化资源配置，提高经济运行质量，促进企业改革发展，推进中国经济体制与经济增长方式的两个根本性转变，具有十分重要的意义。

随着经济全球化和信息技术的迅速发展，企业生产资料获取与产品营销范围日趋扩大，社会生产、物资流通、商品交易及其管理方式正在并将继续发生深刻的变革。

我国流通现代化的发展，经营范围广、经营品种多，要求物流组织也必须大型化，物流设施现代化、多样化、一体化，企业竞争优势的途径之一在于成本优势。

而成本优势的建立和保持必须以可靠和高效的物流运作为保证。

国有大中型企业要走出目前的困境，不仅需要生产适销对路的产品、采取正确的营销策略、以及强有力的资金支持，更需要加强“品质经营”，即强调“时效性”，其核心在于服务的及时性、产品的及时性、信息的及时性和决策反馈的及时性。

这些都必须以强有力的物流能力作为保证。

一次完整的电子商务过程包括由生产厂家将产品生产出来，通过运输、仓储、加工、配送到用户、消费者的物流全过程。

其中分为以下几个方面：生产厂家将生产的单个产品进行包装，并将多个产品集中在大的包装箱内；然后，经过运输、批发等环节，在这一环节中通常需要更大的包装；最后，产品通过零售环节流通到消费者手中，产品通常在这一环节中再还原为单个产品。

人们将上述过程的管理称之为供应链物流管理。

贸易过程中的商品从厂家到最终用户的物流过程是客观存在的，长期以来人们从未主动地、系统地、整体地去考虑，因而未能发挥其系统的总体优势。

供应链物流的地域和时间跨度大，为此，我们这次毕业设计特此开发了物流管理系统。

关键词: 货运物流，商品交易，供应链物流管理1Fr e i g ht l og i s t i c s ma na g e me nt s y s t e mAbs t r actMode r n l ogi s t i cs a s a m e ans of t he or gani zat i on and m a nage m e nt of advanced t echnol ogi es a r e wi del y r ecogni zed a s ent er pr i s es i n r educi ng m a t er i a l cons umpt i on, i mpr ove l abor pr oduct i vi t y out s i de i mpor t ant s our ce of pr of i t s i n t he nat i onal economy and s oci a l devel opme nt pl ays an i mpor t ant r ol e . Ac cel er a t i ng t he devel opme nt of mode r n l ogi s t i cs i n Chi na f or opt i m i zi ng t he a l l ocat i on of r es our ces , i mpr ovi ng t he qual i t y of economi c oper a t i on, and pr omot e t he r ef or m and devel opme nt of ent er pr i s es and pr omot i ng Chi na ' s economi c s t r uct ur e and mode of economi c gr owt h t wo f unda me nt a l changes i s of gr eat s i gni f i ca nce. W i t h economi c gl obal i zat i on and t he r api d devel opme n t of i nf or ma t i on t echnol ogy, acces s t o me a ns of pr oduct i on and ma r ket i ng ent er pr i s es a r e i ncr eas i ngl y expandi ng t he s cope of s oci a l pr oduct i on, ma t er i a l f l ows , commodi t y t r adi ng and ma nage me nt me t hods a r e bei ng and wi l l cont i nue t o under go pr of ound changes . M y f l ow of t he devel opme nt of mode r ni zat i on, bus i nes s s cope, mul t i - s peci es m a nage m e nt , l ogi s t i cs r equi r e me nt s of l a r ge or gani zat i ons mus t , l ogi s t i cs f aci l i t i es mode r ni zat i on, di ver s i f i cat i on, i nt egr a t i on, ent er pr i s e compe t i t i ve advant age l i es i n t he wa y of cos t advant ages . And t he cos t advant ages of t he need t o es t abl i s h and m a i nt a i n r e l i abl e and ef f i c i ent l ogi s t i cs oper a t i on t o ens ur e . M e di um- s i zed s t a t e- owne d ent er pr i s es t o come out of t he cur r ent di f f i cul t i es need not onl y t he pr oduct i on of ma r ket abl e pr oduct s , t he adopt i on of a cor r ect m a r ket i ng s t r a t egy, and s t r ong f i nanci a l s uppor t , but a l s o t he need t o s t r engt hen t he " qual i t y m a nage m e nt " , whi ch s t r es s ed t hat " t i me l i nes s " , t he cor e l i es i n t he t i me l i nes s of s er vi ces and pr oduct s t i me l i nes s , t he t i me l i nes s of t he i nf or ma t i on and deci s i on- m a ki ng f eedback t i me l i nes s . The s e mus t be s t r ong l ogi s t i cs capabi l i t i es as a guar ant ee.I s a compl et e e- comme r ce pr oces s i ncl udes pr oduct s pr oduced by m a nuf act ur er s wi l l be t hr ough t r ans por t , s t or age, pr oces s i ng, di s t r i but i on t o us er s , cons ume r s t hr oughout t he l ogi s t i cs pr oces s . Whi ch i s di vi ded i nt o t he f ol l owi ng a r eas : t he i ndi vi dual ma nuf act ur er s wi l l pr oduce pr oduct s packagi ng, and a numbe r of pr oduct s f ocus ed on l a r ge boxes ; The n, a f t er t r ans por t a t i on, whol es a l e and l i nks i n t he chai n, us ual l y r equi r es gr eat er packagi ng; Fi nal l y , t he f l ow of pr oduct s t hr o ught he r et a i l chai n t o cons ume r s , t he pr oduct i s us ua l l y f ur t her back i n t he chai n f or i ndi vi dual pr oduct s . I t wi l l be known a s t he s uppl y chai n ma nage m e nt pr oces s l ogi s t i cs m a nage m e nt .Tr ade pr oces s f r om m a nuf act ur er s t o end- us er s of commodi t i es l ogi s t i cs pr oces s i s an obj ect i ve exi s t ence, i t has never been act i ve, s ys t e m a t i c , i nt egr a t ed m a nner t o cons i der , and t hus unabl e t o pl ay i t s over a l l advant ages of t he s ys t e m. Suppl y chai n l ogi s t i cs geogr aphi ca l and t i m e s pan l a r ge, and f or t hi s r eas on we devel oped t he gr aduat e des i gn her eby l ogi s t i cs m a nage m e nt s ys t e m.Ke y wor d : f r e i ght l ogi s t i cs , commodi t y t r a di ng, s uppl y chai n l ogi s t i cs ma nage m e n t目录摘要 (Ⅰ)Abs t r act (Ⅱ)引言 (1)第一章概述 (1)1. 1 管理信息系统概述 (1)1. 2 可行性分析 (1)1. 2. 1 物流管理系统的分析 (1)1. 2. 2 业务流程分析 (1)1. 3 数据库系统设计 (3)1. 4 测试方法简介 (5)1. 4. 1 白盒法 (5)1. 4. 2 黑盒法 (5)1. 4. 3 测试步骤 (5)1. 5 开发工具的选择 (5)第二章编程环境的选择 (9)2. 1 关系型数据库的实现 (9)2. 2 二者的结合（DBA） (9)第三章 W i n dows 下的 Vi s ua l Ba s i c 编程环境简介 (10)3. 1 面向对象的编程 (10)3. 2 实现菜单选项 (10)3. 3 实现工具栏 (10)3. 4 帮助 (11)3. 5 关于版本 (11)第四章使用 Ac c es s 2003 实现关系型数据库 (12)4. 1 数据库的概念 (12)4. 2 新建一个数据库 (12)4. 3 修改已建的数据库 (12)4. 4 实现数据库之间的联系 (12)4. 5 数据库设计 (12)第五章物流系统分析与各功能模块设计 (15)5. 1 物流管理系统系统分析 (15)5. 2 系统模块分析 (15)5. 3 各功能模块设计 (16)总结 (23)参考文献 (24)致谢 (25)附录代码清单 (26)引言当今社会是一个信息社会也是一个知识经济的时代。

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

1.请购作业程序Private Sub ComCX_Click()’查询'在"编号"文本框中输入编号，连接数据库，查询编号，并将"编号","品名","规格","单位","单价"的数据分别导入到相应文本框。

Set CN = New ADODB.ConnectionSet Rs = New ADODB.RecordsetCN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "F:\VB设计专用\仓库数据资料\仓库数据资料.mdb;Persist Security Info=False"'打开数据库Rs.CursorType = adOpenStatic '制定一个静态游标Rs.LockType = adLockOptimistic '设置锁定模式为开放式Rs.Open "select * from JLBH where FtextBHSJ Like'" & "%" & Trim(textBHSJ.Text) & "%" & "'", CNDoEventsDo Until Rs.EOF = TrueIf Rs.EOF = False ThenlistBHSJ1.AddItem (Rs.Fields(0))listPMSJ1.AddItem (Rs.Fields(1))listGGSJ1.AddItem (Rs.Fields(2))listDWSJ1.AddItem (Rs.Fields(3))listDJSJ1.AddItem (Rs.Fields(4))Rs.MoveNextEnd IfLoopEnd SubPrivate Sub comFHZY_Click()’返回上页frmQGZY.HidefrmCKGLXT.ShowEnd SubPrivate Sub comQD_Click()’录入数据If textBHSJ.Text = "" Or textPMSJ.Text = "" Or textGGSJ.Text = "" Or textDWSJ.Text = "" Or textDJSJ.Text = "" Or textQGSLSJ.Text = "" ThenMsgBox "请将数据补充完整!"textBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""textQGSLSJ.Text = ""ElseDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = "Select textBHSJ From qgzy where textBHSJ= '" & Trim(textBHSJ.Text) & "'"strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"strconn = strconn & "F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'"cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)str1 = "Insert Into qgzy (textBHSJ,textPMSJ,textGGSJ,textDWSJ,textDJSJ,textQGSJ)"str1 = str1 + "Values('" & Trim(textBHSJ.Text) & "','" & Trim(textPMSJ.Text) & "','" & Trim(textGGSJ.Text) & "','" & Trim(textDWSJ.Text) & "','" & Trim(textDJSJ.Text) & "','" & Trim(textQGSLSJ.Text) & "')"cnn.Execute str1listBHSJ1.AddItem (Trim(textBHSJ.Text))listPMSJ1.AddItem (Trim(textPMSJ.Text))listGGSJ1.AddItem (Trim(textGGSJ.Text))listDWSJ1.AddItem (Trim(textDWSJ.Text))listDJSJ1.AddItem (Trim(textDJSJ.Text))listQGSLSJ1.AddItem (Trim(textQGSLSJ.Text))MsgBox "数据输入成功!"rst.Closecnn.CloseSet Rs = NothingSet CN = NothingtextBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""textQGSLSJ.Text = ""End IfEnd SubPrivate Sub comsc_Click()’删除If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThentextBHSJ.Text = listBHSJ1.List(i)textPMSJ.Text = listPMSJ1.List(i)textGGSJ.Text = listGGSJ1.List(i)textDWSJ.Text = listDWSJ1.List(i)textDJSJ.Text = listDJSJ1.List(i)textQGSLSJ.Text = listQGSLSJ1.List(i)End IfNextEnd IfDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = "Select FtextBHSJ From jlbh where FtextBHSJ='" & Trim(textBHSJ.Text) & "'"strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"strconn = strconn & "F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'"cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)If rst.EOF = False Thenstr1 = "Delete from qgzy where FtextBHSJ='" & Trim(textBHSJ.Text) & "'"cnn.Execute str1textBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""textQGSLSJ.Text = ""If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThenlistBHSJ1.RemoveItem (i)listPMSJ1.RemoveItem (i)listGGSJ1.RemoveItem (i)listDWSJ1.RemoveItem (i)listDJSJ1.RemoveItem (i)listQGSLSJ1.RemoveItem (i)End IfNextEnd IfMsgBox "数据已删除！"ElseMsgBox "无此数据！"textBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""textQGSLSJ.Text = ""End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingEnd Sub‘以下是listbox串连显示Private Sub listBHSJ1_Click()If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThenlistPMSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listDJSJ1_Click()If listDJSJ1.SelCount > 0 ThenFor i = listDJSJ1.ListCount - 1 To 0 Step -1If listDJSJ1.Selected(i) ThenlistQGSLSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listDWSJ1_Click()If listDWSJ1.SelCount > 0 ThenFor i = listDWSJ1.ListCount - 1 To 0 Step -1If listDWSJ1.Selected(i) ThenlistDJSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listGGSJ1_Click()If listGGSJ1.SelCount > 0 ThenFor i = listGGSJ1.ListCount - 1 To 0 Step -1If listGGSJ1.Selected(i) ThenlistDWSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listPMSJ1_Click()If listPMSJ1.SelCount > 0 ThenFor i = listPMSJ1.ListCount - 1 To 0 Step -1If listPMSJ1.Selected(i) ThenlistGGSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listQGSLSJ1_Click()If listQGSLSJ1.SelCount > 0 ThenFor i = listQGSLSJ1.ListCount - 1 To 0 Step -1If listQGSLSJ1.Selected(i) ThenlistBHSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd Sub2.增加料号程序Private Sub comFHZY_Click()’返回上页frmJLBH.HidefrmCKGLXT.ShowEnd SubPrivate Sub comSCBH_Click()’删除If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThentextBHSJ.Text = listBHSJ1.List(i)textPMSJ.Text = listPMSJ1.List(i)textGGSJ.Text = listGGSJ1.List(i)textDWSJ.Text = listDWSJ1.List(i)textDJSJ.Text = listDJSJ1.List(i)End IfNextEnd IfDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = "Select FtextBHSJ From jlbh where FtextBHSJ='" & Trim(textBHSJ.Text) & "'"strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"strconn = strconn & "F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'"cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)If rst.EOF = False Thenstr1 = "Delete * from jlbh where FtextBHSJ='" & Trim(textBHSJ.Text) & "'"cnn.Execute str1textBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThenlistBHSJ1.RemoveItem (i)listPMSJ1.RemoveItem (i)listGGSJ1.RemoveItem (i)listDWSJ1.RemoveItem (i)listDJSJ1.RemoveItem (i)End IfNextEnd IfMsgBox "编号已删除！"ElseMsgBox "无此编号！请确认后重新输入"textBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingEnd SubPrivate Sub comZJBH_Click()’新增料号If textBHSJ.Text = "" Or textPMSJ.Text = "" Or textGGSJ.Text = "" Or textDWSJ.Text = "" Or textDJSJ.Text = "" ThenMsgBox "请将数据补充完整!"textBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""ElseDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As StringstrSql = "Select FtextBHSJ From jlbh where FtextBHSJ= '" & Trim(textBHSJ.Text) & "'"strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='"strconn = strconn & "F:\VB设计专用\仓库数据资料\仓库数据资料.mdb'"cnn.ConnectionString = strconncnn.OpenSet rst = cnn.Execute(strSql)If rst.EOF = False ThenMsgBox "该编号已存在，不能追加！"Elsestr1 = "Insert Into jlbh (FtextBHSJ,FtextPMSJ,FtextGGSJ,FtextDWSJ,FtextDJSJ)"str1 = str1 + "Values('" & Trim(textBHSJ.Text) & "','" & Trim(textPMSJ.Text) & "','" & Trim(textGGSJ.Text) & "','" & Trim(textDWSJ.Text) & "','" & Trim(textDJSJ.Text) & "')"cnn.Execute str1listBHSJ1.AddItem (Trim(textBHSJ.Text))listPMSJ1.AddItem (Trim(textPMSJ.Text))listGGSJ1.AddItem (Trim(textGGSJ.Text))listDWSJ1.AddItem (Trim(textDWSJ.Text))listDJSJ1.AddItem (Trim(textDJSJ.Text))MsgBox "恭喜您，添加成功!"End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingtextBHSJ.Text = ""textPMSJ.Text = ""textGGSJ.Text = ""textDWSJ.Text = ""textDJSJ.Text = ""End IfEnd Sub‘以下是listbox循环选中程序Private Sub listBHSJ1_Click()If listBHSJ1.SelCount > 0 ThenFor i = listBHSJ1.ListCount - 1 To 0 Step -1If listBHSJ1.Selected(i) ThenlistPMSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listDJSJ1_Click()If listDJSJ1.SelCount > 0 ThenFor i = listDJSJ1.ListCount - 1 To 0 Step -1If listDJSJ1.Selected(i) ThenlistBHSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listDWSJ1_Click()If listDWSJ1.SelCount > 0 ThenFor i = listDWSJ1.ListCount - 1 To 0 Step -1If listDWSJ1.Selected(i) ThenlistDJSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listGGSJ1_Click()If listGGSJ1.SelCount > 0 ThenFor i = listGGSJ1.ListCount - 1 To 0 Step -1If listGGSJ1.Selected(i) ThenlistDWSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd SubPrivate Sub listPMSJ1_Click()If listPMSJ1.SelCount > 0 ThenFor i = listPMSJ1.ListCount - 1 To 0 Step -1If listPMSJ1.Selected(i) ThenlistGGSJ1.Selected(i) = TrueEnd IfNextEnd IfEnd Sub。