仓库管理系统VBAccess源代码

1、仓库管理系统项目的建立这是本人利用闲暇之余在上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。此文可作供初学者们学习交流。作者联系方式：E-mail最终运行效果打开软件出现如下登录界面输入系统预设用户名及密码（11 ）单击“登录”或单击“新用户”添加新用户进入如下主界面：建立工程1、创建标准EXE2、按“打开”3、添加MDI窗体一一打开4、编辑菜单在空白处右击点击“菜单编辑器”在“标题”里输入“系统”，在“名称”里输入“ SyS（注意此处不能为汉字）点击“下一个”再点击“确定”退到 MDI界面点击“系统”一一“退出”

2、如下，然后编写代码。代码如下：Private Sub Exit_Click()EndEnd Sub点击“文件” _ “新建”Microsoft Access-“ Version MDB”输入数据库名,“保存”出现如下图e 录 義襄*査霰翌 土nlt.ss戶HK归出人甲+:上数据库的建立中可以创建Access数据库。如下建立一个“用户表”的数据库，用来存放用户信息及一 些出入库管理信息。如下图单击“外接程序”再单击“可视化数据管理器”出现如图在数据窗口中右击一一“新建表”，最终如下往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。登录界面窗口的建立最终界面如下:帰無呼医|宙口血 帮创密I* V

3、jflPat-Hi 口| M单击确定”在工具栏中会出现护”图标，单击它并拖动到相应位置即可。其它元件不在 -说明。2、本窗体代码如下：Private Sub Command1_Click()If = 确定And = 取消ThenIf = ThenMsgBox 请输入用户名！, 登录信息提示:“登录”、“确定”按钮如果为“确定”则添加新用户提示用户输入用户名Exit SubElseDim usename As StringDim strS As Stringusename = TrimstrS = select * from=adCmdText=strS检测用户名是否已经存在用户登录信息表 wh

4、ere用户名=，& use name &If = False ThenMsgBox _ nn您输入的用户已存在!,登录提示信息:1、Adodcl的添加过程为：单击“工程”一一“部件”出现下图所示，选择“控件”下的a Microsoft ADO Data Con trol(OLEDB”Exit SubEnd IfEnd IfIf = Then 提示用户密码不能为空MsgBox 密码不能为空 !, , 登录提示信息： Exit SubEnd IfIf = ThenMsgBox 请再次输入密码 !, , 登录提示信息： Exit SubEnd IfIf ThenMsgBox 两次输入的密码不一致 ,

5、 请确认 !, , 登录提示信息： Exit SubElse 添加新用户用户名 ) = Trim密码 ) = TrimMsgBox ( 添加新用户成功，现在您可以登陆系统了！ )= False= False= 登录 = 退出 End IfElse “登录”按钮，用户登录Dim strSno As StringDim strSelect As StringstrSno = Trim 检测用户名是否存在strSelect = select 密码 from 用户登录信息表 where 用户名 = & strSno & = adCmdText= strSelectIf = True ThenMsgBo

6、x 用户名不存在，请重新输入！ , , 登录提示信息： = _ HI!Exit SubEnd If退出”或“取消”按钮新用户”按钮Unload MeMsgBox 登陆成功！ , , 登录提示信息： ElseMsgBox 密码不正确，请重新输入！ , , 登录提示信息：_ HI!End IfEnd IfEnd SubPrivate Sub Command2_Click()If = 取消 Then= False= False= 登录 = 退出 ElseEnd Unload MeEnd IfEnd SubPrivate Sub Command3_Click()= True= True= 确定= 取消

7、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= FalseIf密码) = Trim Then检测密码是否正确End SubPrivate Sub T

8、imer1_Timer()用来If + 0 Then-80Else时间time1控件的time事件代码，显示向左移动的欢迎字幕当标签右边位置大于 0时，标签向左移否则标签从头开始End IfIf + 0 Then-80ElseEnd IfEnd Sub主界面窗体如下:代码:Private Sub AddNew_Click()=True=FalseEnd SubPrivate Sub CHKPMCHX_Click()出库信息请输入 , 0)Dim pm As StringDim n As Stringpm = InputBox( 产品名 , 请输入 , 0)n = select * from 出

9、库表 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()IEnd SubPrivate Sub CKJSHR_Click()= 出库信息 Dim JSHR As StringDim

10、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, n = select * from 出库表 where 出库日期 = & CHKRQ & = adCmdText= nCall

11、 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 用户登录信

12、息表 where 用户名 = & usename & = adCmdText= strSIf = False ThenMsgBox 您输入的用户已存在 !, , 登录提示信息： = = _ HI!Exit SubEnd IfEnd IfIf = Then 提示用户密码不能为空MsgBox 密码不能为空 !, , 登录提示信息： Exit SubEnd IfIf = ThenMsgBox 请再次输入密码 !, , 登录提示信息： Exit SubEnd IfIf ThenMsgBox 两次输入的密码不一致 , 请确认 !, , 登录提示信息： 提示信息 !)Exit SubElse 添加新用户用

13、户名 ) = Trim密码 ) = TrimDim X As IntegerX = MsgBox( 成功添加新用户，是否要重新登录 !, vbYesNo + vbQuestion + vbDefaultButton1,If X = vbYes ThenUnload MeEnd IfMsgBox (成功添加新用户！ ) = False = False = 登录 = 退出End If= False= TrueEnd SubPrivate Sub Command2_Click()= False= TrueEnd SubPrivate Sub CXDL_Click()Unload MeEnd SubP

14、rivate Sub Exit_Click()EndUnload Form1Unload Form2Unload Form3Unload Form4Unload Form5Unload Form6Unload Form7Unload Form8End SubPrivate Sub Form_Load()TextUserName = Trim Unload Form1 = FalseCall InitGrid0= - 1060= - 560End SubPrivate Sub GHCZ_Click()End SubPrivate Sub GHPMCX_Click()= 归还信息 Dim pm A

15、s 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 SubPr

16、ivate Sub GHSJCX_Click()= 归还信息 Dim JCRQ As String请输入, 0)Dim n As StringJCRQ = InputBox( 归还日期，格式为：月 / 日 / 年 如： 12/1/2011, n = select * from 归还表 where 归还日期 = & JCRQ & = adCmdText= nCall InitGrid2End SubPrivate Sub GHXHCX_Click()= 归还信息 Dim XH As StringDim n As StringXH = InputBox( 产品型号 , 请输入 , 0)n = se

17、lect * from 归还表 where 型号 = & XH & = adCmdText= nCall InitGrid2End SubPrivate Sub GHZCX_Click()= 归还信息 Dim ZB As StringZB = select * from 归还表 = adCmdText= ZBCall InitGrid2End SubPrivate Sub JCCZ_Click()IEnd SubPrivate Sub JCHPMCHX_Click()= 借出信息 Dim pm As StringDim n As Stringpm = InputBox( 产品名 , 请输入 ,

18、 0)n = select * from 借出表 where 品名 = & pm & = adCmdText请输入, 0)Call 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 Stri

19、ngDim 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, n = select * from 借出表 where 借出日期 = & JCRQ & = adCmdText= nC

20、all 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

21、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 品名

22、= & pm & = adCmdText= nCall InitGrid0End SubPrivate Sub RKCZ_Click()IEnd SubPrivate Sub RKJSHR_Click()= 入库信息 Dim JSHR As StringDim n As StringJSHR = InputBox( 经手人 , 请输入 , 0)请输入, 0)n = select * from 入库表 where 经手人 = & JSHR & = adCmdText= nCall InitGrid1End SubPrivate Sub RKPMCHX_Click()= 入库信息 Dim pm A

23、s 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, n = select * from 入库表 where 入库日期 = &

24、 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 * fro

25、m入库表= adCmdText= ZBCall InitGrid1End SubPrivate Sub Timer1_Timer()If + 0 Then 当标签右边位置大于 0 时，标签向左移- 80Else 否则标签从头开始End IfIf + 0 Then- 80ElseEnd IfIf + 0 Then- 80ElseEnd IfIf + 0 Then- 80ElseEnd IfEnd SubPrivate Sub XGMM_Click()IEnd SubPrivate Sub XHCX_Click()= 库存信息 Dim XH As StringDim n As StringXH =

26、 InputBox( 产品型号 , 请输入 , 0)If Len(XH) 0 Then And Val(XH) 0 n = select * from 库存表 where 型号 = & XH & = adCmdText= nEnd IfCall InitGrid0End SubPrivate Sub ZB_Click()= 库存信息 Dim ZB As StringDim N As StringPM = InputBox( 产品名 , 请输入 , 0)ZB = select * from 库存表 where 品名 = & PM & = adCmdText= ZBCall InitGrid0En

27、d 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).Wid

28、th = 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 = 学分 成绩.Colum ns(3) .Captio n =设置DtgCond的列宽.Colum n

29、s(0).Width = 800.Colum ns(1).Width = 1600.Colum ns(2).Width = 1600.Colum ns(3).Width = 800.Colum ns(4).Width = 800.Colum ns(5).Width = 800.Colum ns(6).Width = 1000.Colum ns(7).Width = 800.Colum ns(8).Width = 4000End WithEnd Sub用户重新登录界面代码：Private Sub Command1_Click()Dim strSno As StringDim strSelect

30、As StringstrS no = Trim检测用户名是否存在strSelect = select密码 from 用户登录信息表 where 用户名=& strSno &=adCmdText=strSelectIf = True ThenMsgBox 用户名不存在，请重新输入！,登录提示信息:Exit Sub代码:Private Sub Comma nd1_Click()If Trim The nMsgBox 用户名不正确，请确认！, 信息提示!Exit SubElseDim name As StringDim names As Stringname = Trimnames = select

31、 * from=adCmdText用户登录信息表 where用户名=，& name &=namesEnd IfIf 密码)=Trim Then检测密码是否正确Unload MeMsgBox 登陆成功！,登录提示信息：ElseMsgBox 密码不正确，请重新输入！, 登录提示信息：_ HHEnd IfEnd SubPrivate Sub Command2_Click()Unload MeEnd Sub修改用户密码界面If = ThenMsgBox 请输入旧密码 !, , 信息提示！ Exit SubEnd IfIf 密码 ) Trim ThenMsgBox 旧密码不正确，请确认 !, , 信息提

32、示！ _ HI!Exit SubEnd IfIf = ThenMsgBox 请输入新密码 !, , 信息提示！ Exit SubEnd If If = ThenMsgBox 请再次输入新密码 !, , 信息提示！ Exit SubEnd IfIf Trim Trim ThenMsgBox 两次输入的新密码不一致 !, , 信息提示！ _ HI!= Exit SubElse 密码 ) = TrimMsgBox ( 密码修改成功！ )Unload MeIEnd IfEnd IfEnd SubPrivate Sub Command2_Click()Unload MeEnd Sub入库管理代码：Pri

33、vate Sub Command1_Click()If = And = ThenMsgBox “品名”和“型号”不能同时为空，必须输入其中一项r:,提示信息!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 S

34、tringDim n As String提示信息 !)Dim m As String pm = Trim n = Val pms = 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 =

35、 MsgBox( 产品入库登记成功，是否继续添加产品 !, vbYesNo + vbQuestion + vbDefaultButton1, If X = vbNo ThenUnload MeIElseEnd If= 入库信息 Dim ZB As StringZB = select * from 入库表 where 品名 = & PM & = adCmdText= ZBSubPrivate Sub Command2_Click()_ nn_ nn_ nn_ nnEnd SubPrivate Sub Command3_Click()Unload MeEnd Sub出库管理代码：Private S

36、ub Command1_Click()If = And = Then = And = ThenMsgBox “品名”和“型号”不能同时为空，必须输入其中一项r:,提示信息!Exit SubElseIf = And = Then = ThenMsgBox 请输入产品“数量”或“单位”之一r:,提示信息!Exit SubEnd IfIf = ThenMsgBox 请经手人签名！, vbCritical,提示信息!Exit SubEnd If添加品名)=Trim Trim型号)=Trim Trim提示信息 !)数量 ) = Trim单位 ) = Trim Trim经手人 ) = Trim 出库日期

37、) = 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 + vbDefa

38、ultButton1, If X = vbNo ThenUnload MeIEnd If= 出库信息 Dim ZB As StringZB = select * from 出库表 where 品名 = & PM & = adCmdText= ZBSubPrivate Sub Command2_Click()型号)请经手人签名！, vbCritical,提示信息!End SubPrivate Sub Command3_Click()Unload MeEnd SubPrivate Sub Form_Load()Do Until1 品名)1 单位)LoopEnd Sub借出管理代码：Private

39、Sub Command1_Click()If = And = Then = And = ThenMsgBox “品名”和“型号”不能同时为空，必须输入其中一项r:,提示信息!Exit SubElseIf = And = Then = ThenMsgBox 请输入产品“数量”或“单位”之一 r:,提示信息!Exit SubEnd IfIf = ThenMsgBox Exit SubEnd If提示信息 !)添加品名 ) = Trim Trim型号 ) = Trim Trim数量 ) = Trim单位 ) = Trim Trim经手人 ) = Trim借出人 ) = Trim 借出日期 ) = D

40、ate说明 ) = TrimEnd IfDim pm As StringDim pms As StringDim n As StringDim m As String pm = Trim n = 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_Clic