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

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

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

作者联系方式：E-mail最终运行效果打开软件出现如下登录界面输入系统预设用户名及密码（ 1 1 ）单击“登录”或单击“新用户”添加新用户进入如下主界面：建立工程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 '如果为“确定”则添加新用户'提示用户输入用户名MsgBox "请输入用户名！", , "登录信息提示："Exit SubElse 'Dim usename As String '检测用户名是否已经存在Dim strS As Stringusename = Trim(Text1.Text)strS = "select * from 用户登录信息表 where 用户名='" & usename & "'"mandType = adCmdTextAdodc1.RecordSource = strSAdodc1.RefreshMsgBox "您输入的用户已存在!", , "登录提示信息："Text1.Text = ""Text2.Text = ""Text3.Text = ""Text1.SetFocusExit SubEnd IfEnd If'提示用户密码不能为空MsgBox "密码不能为空!", , "登录提示信息："Text2.SetFocusExit SubEnd IfIf Text3.Text = "" ThenMsgBox "请再次输入密码!", , "登录提示信息："Text3.SetFocusExit SubEnd IfIf Text2.Text <> Text3.Text ThenMsgBox "两次输入的密码不一致,请确认!", , "登录提示信息：" Text2.Text = ""Text3.Text = ""Text2.SetFocusExit SubElseMsgBox ("添加新用户成功，现在您可以登陆系统了！")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.RefreshMsgBox "用户名不存在，请重新输入！", , "登录提示信息："Text1.Text = ""Text2.Text = ""Text1.SetFocusExit SubEnd IfForm1.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.RefreshMsgBox "您输入的用户已存在!", , "登录提示信息："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 SubElseeDim 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 = True End SubPrivate Sub CXDL_Click()Form3.Show'Unload MeEnd SubPrivate Sub Exit_Click()EndUnload Form1Unload Form2Unload Form3Unload Form4Unload Form5Unload Form6Unload Form7Unload Form8End SubPrivate Sub Form_Load()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 = nAdodc2.RefreshCall 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 pm As StringDim 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 = "借出信息"Dim ZB As StringZB = "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 = 1000End 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(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.RefreshMsgBox "用户名不存在，请重新输入！", , "登录提示信息："Text1.Text = ""Text2.Text = ""Text1.SetFocusExit SubEnd IfUnload 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 IfMsgBox "旧密码不正确，请确认!", , "信息提示！"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 SubElseMsgBox ("密码修改成功！")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.RefreshEnd 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 & "'"With Form2End WithElseEnd 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 IfDim ZB As StringZB = "select * from 入库表 " 'where 品名 = '" & PM & "'" End 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 = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"Exit SubElseIf Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" Then MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Text2.SetFocusExit SubEnd IfIf Text2.Text = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Text2.SetFocusExit SubEnd IfAdodc1.RefreshEnd 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 & "'"End 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 = ""Dim ZB As StringZB = "select * from 出库表 " 'where 品名 = '" & PM & "'"End 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.RefreshLoopEnd Sub借出管理代码：Private Sub Command1_Click()If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"Exit SubElseIf Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" Then MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Text1.SetFocusExit SubEnd IfIf Text2.Text = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Text2.SetFocusExit SubEnd IfAdodc1.RefreshEnd 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 & "'"End 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 = ""Dim ZB As StringZB = "select * from 借出表 " 'where 品名 = '" & PM & "'"End 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 SubPrivate Sub Form_Load()Adodc2.RefreshLoopEnd Sub归还管理代码：Private Sub Command1_Click()If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" ThenMsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"Exit SubElseIf Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" Then MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"Text1.SetFocusExit SubEnd IfIf Text2.Text = "" ThenMsgBox "请经手人签名!", vbCritical, "提示信息!"Text2.SetFocusExit SubEnd IfIf Text3.Text = "" ThenMsgBox "请输入归还人姓名!", vbCritical, "提示信息!" Text3.SetFocusExit SubEnd IfAdodc1.RefreshEnd 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 & "'"End 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 = ""Dim ZB As StringZB = "select * from 归还表 " 'where 品名 = '" & PM & "'"End 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 SubPrivate Sub Form_Load()' Dim i As String' i = 0' Adodc2.Refresh' 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 = 0Adodc2.Refreshi = i + 1LoopD = Split(a, ",")If j < i Thens = D(2)Combo1.AddItem s'k = 0'If k < j And D(k) <> D(j) Then'If D(k) <> D(j) Then' Combo1.AddItem D(j)' k = k + 1' Else' k = k + 1'End If'End Ifj = j + 1End IfText5.Text = s 'a + "," + D(2) + D(1) '+ " " + Val(i) + " " + Val(j) + " " + Val(k)Text6.Text = j'Combo1.AddItem D(1) End Sub。