仓库管理系统VBAccess源代码

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

2、出”如下，然后编写代码。代码如下：Private Sub Exit_Click() EndEnd Sub数据库的建立中可以创建Access数据库。如下建立一个“用户表”的数据库，用来存放用户信息及一 些出入库管理信息。如下图单击“外接程序”外接注序&加也脚再单击“可视化数据管理器”出现如图点击文件新建 Microsoft Access”“ Version MDB”输入数据库名,“保存”出现如下图在数据窗口中右击一一“新建表”，最终如下a 条 表表*表次理 土nlt.s库户 信库归出AWa嘛丸裒往数据表里添加数据在这里就不罗嗦了，请查阅相关书籍。登录界面窗口的建立最终界面如下:FM INiI i

3、i*1、Adodcl的添加过程为：单击“工程”一一“部件”出现下图所示，选择“控件”下的 Microsoft ADO Data Control(OLEDB”单击“确定”在工具栏中会出现“”图标，单击它并拖动到相应位置即可。其它元件不在一一说明。2、本窗体代码如下：Private Sub Command1_Click()登录”、“确定”按钮If =确定And =取消Then如果为“确定”则添加新用户If = Then提示用户输入用户名MsgBox 请输入用户名！一 登录信息提示：Exit SubElseDim usename As String检测用户名是否已经存在Dim strS As Str

4、ingusename = TrimstrS = select * from用户登录信息表 where 用户名=& usename & =adCmdText=strSIf = False ThenMsgBox 您输入的用户已存在！,，”登录提示信息：=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 ThenMsgBox 用户名不存在，请重新输入！ , , 登录

6、提示信息： = = Exit SubEnd IfIf 密码 ) = Trim Then检测密码是否正确Unload MeMsgBox 登陆成功！ , , 登录提示信息： ElseMsgBox 密码不正确，请重新输入！ , , 登录提示信息： = 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= FalseEnd Sub时间timel控件的time事件代码,P

8、rivate Sub Timer1_Timer()用来显示向左移动的欢迎字幕当标签右边位置大于 0时，标签向左移否则标签从头开始If + 0 Then-80ElseEnd IfIf + 0 Then-80ElseEnd IfEnd Sub主界面窗体如下:代码:Private Sub AddNew_Click()=True=FalseEnd SubPrivate Sub CHKPMCHX_Click()出库信息”Call InitGrid1Dim pm As StringDim n As String pm = 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() End 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, 请输入 , 0) n = select * from 出库表 where 出库日期 = & CHKRQ & = adCmdText

11、= nEnd SubPrivate Sub CKZCX_Click() = 出库信息 Dim ZB As StringZB = select * from 出库表 = adCmdText = ZBCall InitGrid1End SubPrivate Sub Command1_Click()If = Then提示用户输入用户名MsgBox 请输入用户名！ , , 登录信息提示： Exit SubElseDim usename As String检测用户名是否已经存在Dim strS As String usename = TrimstrS = select * from用户登录信息表wher

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

13、mDim X As IntegerX = MsgBox( 成功添加新用户，是否要重新登录!, vbYesNo + vbQuestion + vbDefaultButton1, 提示信息 !)If X = vbYes ThenUnload MeEnd IfMsgBox ( 成功添加新用户！ ) = False = False = 登录 = 退出End If= False= True= = = End SubPrivate Sub Command2_Click()= False= TrueEnd SubPrivate Sub CXDL_Click()Unload MeEnd SubPrivate

14、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 As St

15、ringDim 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 SubPrivat

16、e 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

17、 * 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

18、 = select * from 借出表 where 品名 = & pm & = adCmdTextCall InitGrid End SubCall 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 J

19、CR 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

20、& = adCmdText= nCall InitGrid2End SubPrivate Sub JCZCX_Click()= 借出信息 Dim ZB As StringZB = select * from 借出表 = adCmdText= ZBPrivate Sub JSHRCHX_Click()= 归还信息 Dim JSHR As StringDim n As StringJSHR = InputBox( 经手人 , 请输入 , 0)n = select * from 归还表 where 经手人 = & JSHR & = adCmdText= nCall InitGrid2End SubP

21、rivate 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() End SubPrivate Sub RKJSHR_Click()= 入库信息 Dim JSHR As StringDim n As StringJSHR = InputBox( 经手人 , 请输入 , 0)Call InitGrid End Subn = select * from入库表 where 经手人 = & JSHR & = adCmdText= nCall InitGrid1End SubPrivate Sub RKPMCHX_Click()= 入库信息

23、 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 入

24、库表 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 IfPrivate Sub RKZCX_Click()= 入库信息 Dim ZB As StringZB = select * from 入

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

26、产品型号 , 请输入 , 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 StringDim N As StringPM = InputBox( 产品名 , 请输入 , 0)ZB = select * from 库存表 where 品名 = & PM & = adCmdText= ZBCall InitGrid0End SubPrivate

27、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.Col

28、umns(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 =Exit Sub.Columns(3).Caption = 成绩设置DtgCond的列宽.Columns(0).Width

29、= 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 = T

30、rim检测用户名是否存在strSelect = select密码from 用户登录信息表 where 用户名=& strSno & 川=adCmdText=strSelectIf = True ThenMsgBox 用户名不存在，请重新输入！一登录提示信息:=End IfIf 密码)=Trim Then检测密码是否正确Unload MeMsgBox 登陆成功！一 登录提示信息：ElseMsgBox 密码不正确，请重新输入！一 登录提示信息：=End IfEnd SubPrivate Sub Command2_Click()Unload MeEnd Sub修改用户密码界面代码：Private S

31、ub 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 = ThenMsgB

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

33、ox “品名”和“型号”不能同时为空，必须输入其中一项！，” 提示信息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 StringPrivate Sub Command2_

34、Click()Dim m As String pm = Trim n = 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 Integer提示信息 !)X = MsgBox( 产品入库登记成功，是否继续添加产品

35、 !, vbYesNo + vbQuestion + vbDefaultButton1, If X = vbNo ThenUnload Me Else = = = = = = = End If= 入库信息 Dim ZB As StringZB = select * from 入库表 where 品名 = & PM & = adCmdText= ZBSub-= =End SubPrivate Sub Command3_Click() Unload Me End Sub出库管理代码：Private Sub Command1_Click()If = And = Then = And = ThenMs

36、gBox “品名”和“型号”不能同时为空，必须输入其中一项！，”提示信息Exit SubElseIf = And = Then = ThenMsgBox 请输入产品“数量”或“单位”之一 !,提示信息！Exit SubEnd IfIf = ThenMsgBox 请经手人签名!, vbCritical,提示信息！Exit SubEnd If添加品名)=Trim Trim型号)=Trim Trim数量) =Trim单位) =TrimTrim经手人)= Trim 出库日期 ) = Date说明) =TrimEnd IfDim pm As StringDim pms As StringDim n As

37、 StringDim m As Stringpm = Trimn = Valpms = select * from 库存表 where 品名 = & pm & = adCmdText= pmsm = 数量 ).ValueIf 型号) = Trim Then数量 ) = Val(m) - Val(n)End IfDim X As Integer提示信息 !)X = MsgBox( 产品出库登记成功，是否继续添加产品 !, vbYesNo + vbQuestion + vbDefaultButton1,If X = vbNo Then Unload Me End If= 出库信息 Dim ZB A

38、s String出库表 where 品名 = & PM & ZB = select * from= 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 “品名”和“型号”不能同时为空，必须输入其中一项！，”提

39、示信息Exit SubElseIf = And = Then = ThenMsgBox请输入产品“数量”或“单位”之一 !,提示信息！Exit SubEnd IfIf = ThenMsgBox 请经手人签名!, vbCritical,提示信息！Exit SubEnd IfPrivate Sub Command2_Click()添加品名)= Trim Trim型号)= Trim Trim数量)= Trim单位)= Trim Trim经手人) = Trim借出人) = Trim 借出日期 ) = Date说明)= TrimEnd IfDim pm As StringDim pms As Strin

40、gDim 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= ZBSub=End SubPrivate Sub Command3_Click()Unload MeEnd SubPrivate Sub Form_Load()Do Until 品名) 型号)单位)LoopEnd Sub归还管理代码：Private Sub Command1_Click()If = And = Then = And = ThenMsgBox “品名”和“型号”不能同时为空