admin 管理员组文章数量: 1184232
2024年3月7日发(作者：java技术文档)
仓库管理系统
项目的建立
这是本人利用闲暇之余在上制作的一个简陋的类库管系统,现图文结合的方式一步一步展现制作过程;由于本人是个初学者,里面存在很多不足之处望得到高手们的指导;此文可作供初学者们学习交流;作者：E-mail
最终运行效果
打开软件出现如下登录界面
输入系统预设用户名及密码 1 1 单击“登录”或单击“新用户”添加新用户进入如下主界面：
建立工程
1、 创建标准EXE
2、 按“打开”
3、 添加MDI窗体——打开
4、 编辑菜单
在空白处右击——点击“菜单编辑器”
在“标题”里输入“系统”,在“名称”里输入“Sys”注意此处不能为汉字
点击“下一个”再点击“ ”
“确定”退到MDI界面点击“系统”——“退出”如下,然后编写代码;
代码如下：
Private Sub Exit_Click
End
End 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 Sub
Else '
Dim usename As String '检测用户名是否已经存在
Dim strS As String
usename = Trim
strS = "select from 用户登录信息表 where 用户名='" & usename & "'"
= adCmdText
= strS
If = False Then
MsgBox "您输入的用户已存在", , "登录提示信息："
= ""
= ""
= ""
”图标,单击它并拖动到相应位置即可;其它元件不
Exit Sub
End If
End If
If = "" Then '提示用户密码不能为空
MsgBox "密码不能为空", , "登录提示信息："
Exit Sub
End If
If = "" Then
MsgBox "请再次输入密码", , "登录提示信息："
Exit Sub
End If
If <> Then
MsgBox "两次输入的密码不一致,请确认", , "登录提示信息："
= ""
= ""
Exit Sub
Else
'添加新用户
"用户名" = Trim
"密码" = Trim
MsgBox "添加新用户成功,现在您可以登陆系统了"
= False
= False
= "登录"
= "退出"
End If
Else '“登录”按钮,用户登录
Dim strSno As String
Dim strSelect As String
strSno = Trim '检测用户名是否存在
strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'"
= adCmdText
= strSelect
If = True Then
MsgBox "用户名不存在,请重新输入", , "登录提示信息："
= ""
= ""
Exit Sub
End If
If "密码" = Trim Then '检测密码是否正确
'Unload Me
'MsgBox "登陆成功", , "登录提示信息："
Else
MsgBox "密码不正确,请重新输入", , "登录提示信息："
= ""
End If
End If
End Sub
Private Sub Command2_Click '“退出”或“取消”按钮
If = "取消" Then
= False
= False
= "登录"
= "退出"
= ""
= ""
Else
End 'Unload Me
End If
End Sub
Private Sub Command3_Click '“新用户”按钮
= True
= True
= ""
= ""
= ""
= "确定"
= "取消"
End Sub
Private Sub Command3_MouseDownButton As Integer, Shift As Integer, X As Single, Y As Single
= True
End Sub
Private Sub Command3_MouseUpButton As Integer, Shift As Integer, X As Single, Y As Single
= False
End Sub
Private Sub Form_Load
= False
= False
End Sub
Private Sub Timer1_Timer '时间time1控件的time事件代码,用来
'显示向左移动的欢迎字幕
If + > 0 Then '当标签右边位置大于0时,标签向左移
- 80
Else '否则标签从头开始
=
End If
If + > 0 Then
- 80
Else
=
End If
End Sub
主界面窗体
如下：
代码：
Private Sub AddNew_Click
= True
= False
End Sub
Private Sub CHKPMCHX_Click
= "出库信息"
Dim pm As String
Dim n As String
pm = InputBox"产品名", "请输入", 0
n = "select from 出库表 where 品名 = '" & pm & "'"
= adCmdText
= n
Call InitGrid1
End Sub
Private Sub CHKXHCHX_Click
= "出库信息"
Dim XH As String
Dim n As String
XH = InputBox"产品型号", "请输入", 0
n = "select from 出库表 where 型号 = '" & XH & "'"
= adCmdText
= n
End Sub
Private Sub CKCZ_Click
'
End Sub
Private Sub CKJSHR_Click
= "出库信息"
Dim JSHR As String
Dim n As String
JSHR = InputBox"经手人", "请输入", 0
n = "select from 出库表 where 经手人 = '" & JSHR & "'"
= adCmdText
= n
Call InitGrid1
End Sub
Private Sub CKSHJ_Click
= "出库信息"
Dim CHKRQ As String
Dim n As String
CHKRQ = InputBox"出库日期,格式为：月/日/年 如：12/1/2011", "请输入", 0
n = "select from 出库表 where 出库日期 = '" & CHKRQ & "'"
= adCmdText
= n
Call InitGrid1
End Sub
Private Sub CKZCX_Click
= "出库信息"
Dim ZB As String
ZB = "select from 出库表 "
= adCmdText
= ZB
Call InitGrid1
End Sub
Private Sub Command1_Click
If = "" Then '提示用户输入用户名
MsgBox "请输入用户名", , "登录信息提示："
Exit Sub
Else '
Dim usename As String '检测用户名是否已经存在
Dim strS As String
usename = Trim
strS = "select from 用户登录信息表 where 用户名='" & usename & "'"
= adCmdText
= strS
If = False Then
MsgBox "您输入的用户已存在", , "登录提示信息："
= ""
= ""
= ""
Exit Sub
End If
End If
If = "" Then '提示用户密码不能为空
MsgBox "密码不能为空", , "登录提示信息："
Exit Sub
End If
If = "" Then
MsgBox "请再次输入密码", , "登录提示信息："
Exit Sub
End If
If <> Then
MsgBox "两次输入的密码不一致,请确认", , "登录提示信息："
= ""
= ""
Exit Sub
Else
'添加新用户
"用户名" = Trim
"密码" = Trim
Dim X As Integer
X = MsgBox"成功添加新用户,是否要重新登录", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息"
If X = vbYes Then
Unload Me
End If
'MsgBox "成功添加新用户"
' = False
' = False
' = "登录"
' = "退出"
End If
= False
= True
= ""
= "'"
= ""
'
End Sub
Private Sub Command2_Click
= False
= True
End Sub
Private Sub CXDL_Click
'Unload Me
End Sub
Private Sub Exit_Click
End
Unload Form1
Unload Form2
Unload Form3
Unload Form4
Unload Form5
Unload Form6
Unload Form7
Unload Form8
End Sub
Private Sub Form_Load
TextUserName = Trim Unload Form1
= False
Call InitGrid0
= - 1060
= - 560
=
=
End Sub
Private Sub GHCZ_Click
'
End Sub
Private Sub GHPMCX_Click
= "归还信息"
Dim pm As String
Dim n As String
pm = InputBox"产品名", "请输入", 0
n = "select from 归还表 where 品名 = '" & pm & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub GHRCX_Click
= "归还信息"
Dim JCR As String
Dim n As String
JCR = InputBox"归还人", "请输入", 0
n = "select from 归还表 where 归还人 = '" & JCR & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub GHSJCX_Click
= "归还信息"
Dim JCRQ As String
Dim n As String
JCRQ = InputBox"归还日期,格式为：月/日/年 如：12/1/2011", "请输入", 0
n = "select from 归还表 where 归还日期 = '" & JCRQ & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub GHXHCX_Click
= "归还信息"
Dim XH As String
Dim n As String
XH = InputBox"产品型号", "请输入", 0
n = "select from 归还表 where 型号 = '" & XH & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub GHZCX_Click
= "归还信息"
Dim ZB As String
ZB = "select from 归还表 "
= adCmdText
= ZB
Call InitGrid2
End Sub
Private Sub JCCZ_Click
'
End Sub
Private Sub JCHPMCHX_Click
= "借出信息"
Dim pm As String
Dim n As String
pm = InputBox"产品名", "请输入", 0
n = "select from 借出表 where 品名 = '" & pm & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub JCHXHCHX_Click
= "借出信息"
Dim XH As String
Dim n As String
XH = InputBox"产品型号", "请输入", 0
n = "select from 借出表 where 型号 = '" & XH & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub JCRCX_Click
= "借出信息"
Dim JCR As String
Dim n As String
JCR = InputBox"借出人", "请输入", 0
n = "select from 借出表 where 借出人 = '" & JCR & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub JCSHJCX_Click
= "借出信息"
Dim JCRQ As String
Dim n As String
JCRQ = InputBox"借出日期,格式为：月/日/年 如：12/1/2011", "请输入", 0
n = "select from 借出表 where 借出日期 = '" & JCRQ & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub JCZCX_Click
= "借出信息"
Dim ZB As String
ZB = "select from 借出表 "
= adCmdText
= ZB
Call InitGrid2
End Sub
Private Sub JSHRCHX_Click
= "归还信息"
Dim JSHR As String
Dim n As String
JSHR = InputBox"经手人", "请输入", 0
n = "select from 归还表 where 经手人 = '" & JSHR & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub JSHRCX_Click
= "借出信息"
Dim JSHR As String
Dim n As String
JSHR = InputBox"经手人", "请输入", 0
n = "select from 借出表 where 经手人 = '" & JSHR & "'"
= adCmdText
= n
Call InitGrid2
End Sub
Private Sub PMCX_Click
= "库存信息"
Dim pm As String
Dim n As String
pm = InputBox"产品名", "请输入", 0
n = "select from 库存表 where 品名 = '" & pm & "'"
= adCmdText
= n
Call InitGrid0
End Sub
Private Sub RKCZ_Click
'
End Sub
Private Sub RKJSHR_Click
= "入库信息"
Dim JSHR As String
Dim n As String
JSHR = InputBox"经手人", "请输入", 0
n = "select from 入库表 where 经手人 = '" & JSHR & "'"
= adCmdText
= n
Call InitGrid1
End Sub
Private Sub RKPMCHX_Click
= "入库信息"
Dim pm As String
Dim n As String
pm = InputBox"产品名", "请输入", 0
If Lenpm > 0 Then
n = "select from 入库表 where 品名 = '" & pm & "'"
= adCmdText
= n
End If
Call InitGrid1
End Sub
Private Sub RKSHJ_Click
= "入库信息"
Dim RKRQ As String
Dim n As String
RKRQ = InputBox"入库日期,格式为：月/日/年 如：12/1/2011", "请输入", 0
n = "select from 入库表 where 入库日期 = '" & RKRQ & "'"
= adCmdText
= n
Call InitGrid1
End Sub
Private Sub RKXHCHX_Click
= "入库信息"
Dim XH As String
Dim n As String
XH = InputBox"产品型号", "请输入", 0
If LenXH > 0 Then
n = "select from 入库表 where 型号 = '" & XH & "'"
= adCmdText
= n
End If
Call InitGrid1
End Sub
Private Sub RKZCX_Click
= "入库信息"
Dim ZB As String
ZB = "select from 入库表 "
= adCmdText
= ZB
Call InitGrid1
End Sub
Private Sub Timer1_Timer
If + > 0 Then '当标签右边位置大于0时,标签向左移
- 80
Else '否则标签从头开始
=
End If
If + > 0 Then
- 80
Else
=
End If
If + > 0 Then
- 80
Else
=
End If
If + > 0 Then
- 80
Else
=
End If
End Sub
Private Sub XGMM_Click
'
End Sub
Private Sub XHCX_Click
= "库存信息"
Dim XH As String
Dim n As String
XH = InputBox"产品型号", "请输入", 0
If LenXH > 0 Then 'And ValXH <> 0
n = "select from 库存表 where 型号 = '" & XH & "'"
= adCmdText
= n
End If
Call InitGrid0
End Sub
Private Sub ZB_Click
= "库存信息"
Dim ZB As String
'Dim N As String
'PM = InputBox"产品名", "请输入", 0
ZB = "select from 库存表 " 'where 品名 = '" & PM & "'"
= adCmdText
= ZB
Call InitGrid0
End Sub
Private Sub InitGrid0
With DataGrid1
. = 1600
. = 2200
. = 2200
. = 1000
. = 1000
. = 4000
End With
End Sub
Private Sub InitGrid1
With DataGrid1
. = 800
. = 1600
. = 1600
. = 800
. = 800
. = 1000
. = 800
. = 4000
End With
End Sub
Private Sub InitGrid2
With DataGrid1
'.n = "学号"
' .n = "课程名"
'.n = "学分"
' .n = "成绩"
'设置DtgCond的列宽
. = 800
. = 1600
. = 1600
. = 800
. = 800
. = 800
. = 1000
. = 800
. = 4000
End With
End Sub
用户重新登录界面
代码：
Private Sub Command1_Click
Dim strSno As String
Dim strSelect As String
strSno = Trim '检测用户名是否存在
strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'"
= adCmdText
= strSelect
If = True Then
MsgBox "用户名不存在,请重新输入", , "登录提示信息："
= ""
= ""
Exit Sub
End If
If "密码" = Trim Then '检测密码是否正确
Unload Me
'MsgBox "登陆成功", , "登录提示信息："
Else
MsgBox "密码不正确,请重新输入", , "登录提示信息："
= ""
End If
End Sub
Private Sub Command2_Click
Unload Me
End Sub
修改用户密码界面
代码：
Private Sub Command1_Click
If Trim <> Then
MsgBox "用户名不正确,请确认", , "信息提示"
= ""
Exit Sub
Else
Dim name As String
Dim names As String
name = Trim
names = "select from 用户登录信息表 where 用户名='" & name & "'"
= adCmdText
= names
If = "" Then
MsgBox "请输入旧密码", , "信息提示"
Exit Sub
End If
If "密码" <> Trim Then
MsgBox "旧密码不正确,请确认", , "信息提示"
= ""
Exit Sub
End If
If = "" Then
MsgBox "请输入新密码", , "信息提示"
Exit Sub
End If
If = "" Then
MsgBox "请再次输入新密码", , "信息提示"
Exit Sub
End If
If Trim <> Trim Then
MsgBox "两次输入的新密码不一致", , "信息提示"
= ""
= ""
Exit Sub
Else
"密码" = Trim
MsgBox "密码修改成功"
Unload Me
'
End If
End If
End Sub
Private Sub Command2_Click
Unload Me
'
End Sub
入库管理
代码：
Private Sub Command1_Click
If = "" And = "" Then
MsgBox "“品名”和“型号”不能同时为空,必须输入其中一项", , "提示信息"
Exit Sub
Else
If = "" And = "" Then
MsgBox "请输入产品“数量”或“单位”之一", , "提示信息"
Exit Sub
End If
If = "" Then
MsgBox "请经手人签名", vbCritical, "提示信息"
Exit Sub
End If
'添加
"品名" = Trim
"型号" = Trim
"数量" = Trim
"单位" = Trim
"经手人" = Trim
"入库日期" = Date
"说明" = Trim
End If
Dim pm As String
Dim pms As String
Dim n As String
Dim m As String
pm = Trim
n = Val
pms = "select from 库存表 where 品名='" & pm & "'"
= adCmdText
= pms
If Then
With Form2
. ."品名" = Trim
."型号" = Trim
."数量" = Trim
."单位" = Trim
."说明" = Trim
. End With
Else
m = "数量".Value
If "型号" = Trim Then
"数量" = Valm + Valn
End If
End If
Dim X As Integer
X = MsgBox"产品入库登记成功,是否继续添加产品", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息"
If X = vbNo Then
Unload Me
'
Else
= ""
= ""
= ""
= ""
= ""
= ""
= ""
End If
= "入库信息"
Dim ZB As String
ZB = "select from 入库表 " 'where 品名 = '" & PM & "'"
= adCmdText
= ZB
Sub
Private Sub Command2_Click
= ""
= ""
= ""
= ""
= ""
= ""
= ""
End Sub
Private Sub Command3_Click
Unload Me
'
End Sub
出库管理
代码：
Private Sub Command1_Click
If = "" And = "" Then ' = "" And = "" Then
MsgBox "“品名”和“型号”不能同时为空,必须输入其中一项", , "提示信息"
Exit Sub
Else
If = "" And = "" Then ' = "" Then
MsgBox "请输入产品“数量”或“单位”之一", , "提示信息"
Exit Sub
End If
If = "" Then
MsgBox "请经手人签名", vbCritical, "提示信息"
Exit Sub
End If
'添加
"品名" = Trim 'Trim
"型号" = Trim 'Trim
"数量" = Trim
"单位" = Trim 'Trim
"经手人" = Trim
"出库日期" = Date
"说明" = Trim
End If
Dim pm As String
Dim pms As String
Dim n As String
Dim m As String
pm = Trim
n = Val
pms = "select from 库存表 where 品名='" & pm & "'"
= adCmdText
= pms
m = "数量".Value
If "型号" = Trim Then
"数量" = Valm - Valn
End If
Dim X As Integer
X = MsgBox"产品出库登记成功,是否继续添加产品", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息"
If X = vbNo Then
Unload Me
'
End If
= ""
= ""
= ""
= ""
= ""
= ""
= ""
= "出库信息"
Dim ZB As String
ZB = "select from 出库表 " 'where 品名 = '" & PM & "'"
= adCmdText
= ZB
Sub
Private Sub Command2_Click
= ""
= ""
= ""
= ""
= ""
= ""
= ""
End Sub
Private Sub Command3_Click
Unload Me
'
End Sub
Private Sub Form_Load
Do Until "型号"
"品名"
"单位"
Loop
End Sub
借出管理
代码：
Private Sub Command1_Click
If = "" And = "" Then ' = "" And = "" Then
MsgBox "“品名”和“型号”不能同时为空,必须输入其中一项", , "提示信息"
Exit Sub
Else
If = "" And = "" Then ' = "" Then
MsgBox "请输入产品“数量”或“单位”之一", , "提示信息"
Exit Sub
End If
If = "" Then
MsgBox "请经手人签名", vbCritical, "提示信息"
Exit Sub
End If
'添加
"品名" = Trim 'Trim
"型号" = Trim 'Trim
"数量" = Trim
"单位" = Trim 'Trim
"经手人" = Trim
"借出人" = Trim
"借出日期" = Date
"说明" = Trim
End If
Dim pm As String
Dim pms As String
Dim n As String
Dim m As String
pm = Trim
n = Val
pms = "select from 库存表 where 品名='" & pm & "'"
= adCmdText
= pms
m = "数量".Value
If "型号" = Trim Then
"数量" = Valm - Valn
End If
Dim X As Integer
X = MsgBox"产品借出登记成功,是否继续添加产品", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息"
If X = vbNo Then
Unload Me
End If
= ""
= ""
= ""
= ""
= ""
= ""
= ""
= "借出信息"
Dim ZB As String
ZB = "select from 借出表 " 'where 品名 = '" & PM & "'"
= adCmdText
= ZB
Sub
Private Sub Command2_Click
= ""
= ""
= ""
= ""
= ""
= ""
= ""
End Sub
Private Sub Command3_Click
Unload Me
End Sub
Private Sub Form_Load
Do Until "品名"
"型号"
"单位"
Loop
End Sub
归还管理
代码：
Private Sub Command1_Click
If = "" And = "" Then ' = "" And = "" Then
MsgBox "“品名”和“型号”不能同时为空,必须输入其中一项", , "提示信息"
Exit Sub
Else
If = "" And = "" Then ' = "" Then
MsgBox "请输入产品“数量”或“单位”之一", , "提示信息"
Exit Sub
End If
If = "" Then
MsgBox "请经手人签名", vbCritical, "提示信息"
Exit Sub
End If
If = "" Then
MsgBox "请输入归还人姓名", vbCritical, "提示信息"
Exit Sub
End If
'添加
"品名" = Trim 'Trim
"型号" = Trim 'Trim
"数量" = Trim
"单位" = Trim 'Trim
"经手人" = Trim
"归还人" = Trim
"归还日期" = Date
"说明" = Trim
End If
Dim pm As String
Dim pms As String
Dim n As String
Dim m As String
pm = Trim
n = Val
pms = "select from 库存表 where 品名='" & pm & "'"
= adCmdText
= pms
m = "数量".Value
If "型号" = Trim Then
"数量" = Valm + Valn
End If
Dim X As Integer
X = MsgBox"产品归还登记成功,是否继续添加产品", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息"
If X = vbNo Then
Unload Me
End If
= ""
= ""
= ""
= ""
= ""
= ""
= ""
= "归还信息"
Dim ZB As String
ZB = "select from 归还表 " 'where 品名 = '" & PM & "'"
= adCmdText
= ZB
Sub
Private Sub Command2_Click
= ""
= ""
= ""
= ""
= ""
= ""
= ""
End Sub
Private Sub Command3_Click
Unload Me
End Sub
Private Sub Form_Load
' Dim i As String
' i = 0
'
' ' Do Until ' "品名"
' "型号"
' "单位"
' ' i = i + 1
' Loop
Call pm
End Sub
Private Sub pm
Dim i As Variant
Dim j As Variant
Dim k As Variant
Dim a As Variant
Dim b As Variant
Dim c As Variant
Dim s As Variant
Dim D As Variant
i = 0
j = 0
Do Until a = a + "," + "品名"
b = b + "," + "型号"
b = b + "," + "单位"
i = i + 1
Loop
D = Splita, ","
If j < i Then
s = D2
s
'k = 0
'If k < j And Dk <> Dj Then
'If Dk <> Dj Then
' Dj
' k = k + 1
' Else
' k = k + 1
'End If
'End If
j = j + 1
End If
= s 'a + "," + D2 + D1 '+ " " + Vali + " " + Valj + " " + Valk
= j
' D1
End Sub
版权声明：本文标题：仓库管理系统VBAccess源代码 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://www.roclinux.cn/b/1709825992a547562.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论