仓库管理系统VBAccess源代码.pdf

文档介绍：该【仓库管理系统VBAccess源代码 】是由【江湖故人】上传分享，文档一共【56】页，该文档可以免费在线阅读，需要了解更多关于【仓库管理系统VBAccess源代码 】的内容，可以使用淘豆网的站内搜索功能，选择自己适合的文档，以下文字是截取该文章内的部分文字，如需要获得完整电子版，请下载此文档到您的设备，方便您编辑和打印。:.
仓库管理系统
项目的建立
这是本人利用闲暇之余在上制作的一个简陋的类库管系统,现图文结合
的方式一步一步展现制作过程。由于本人是个初学者,里面存在很多不足
之处望得到高手们的指导。此文可作供初学者们学****交流。作者联系方式:
E-mail
最终运行效果
打开软件出现如下登录界面
输入系统预设用户名及密码(11)单击“登录”或单击“新用户”添
加新用户进入如下主界面::.
建立工程
1、创建标准EXE
2、按“打开”:.
3、添加MDI窗体——打开
4、编辑菜单
在空白处右击——点击“菜单编辑器”
:.
在“标题”里输入“系统”,在“名称”里输入“Sys”(注意此处不能为
汉字)
点击“下一个”再点击“”
“确定”退到MDI界面点击“系统”——“退出”如下,然后编写代码。
代码如下:
PrivateSubExit_Click():.
End
EndSub
数据库的建立
中可以创建Access数据库。如下建立一个“用户表”的数据库,用来
存放用户信息及一些出入库管理信息。如下图单击“外接程序”
再单击“可视化数据管理器”出现如图
点击“文件”——“新建”——“MicrosoftAccess”——“VersionMDB”
输入数据库名,“保存”出现如下图
在数据窗口中右击——“新建表”,最终如下:.
往数据表里添加数据在这里就不罗嗦了,请查阅相关书籍。
登录界面窗口的建立
最终界面如下:
1、Adodc1的添加过程为:单击“工程”——“部件”出现下图所示,选
择“控件”下的“MicrosoftADODataControl(OLEDB)”
单击“确定”在工具栏中会出现“”图标,单击它并拖动到相应位置
即可。其它元件不在一一说明。:.
2、本窗体代码如下:
PrivateSubCommand1_Click()
'“登录”、“确定”按钮
If="确定"And="取消"Then'如果为“确定”
则添加新用户
If=""Then
'提示用户输入用户名
MsgBox"请输入用户名!",,"登录信息提示:"
ExitSub
Else
'
DimusenameAsString
'检测用户名是否已经存在
DimstrSAsString
usename=Trim
strS="select*from用户登录信息表where用户名='"&
usename&"'"
=adCmdText
=strS
If=FalseThen
MsgBox"您输入的用户已存在!",,"登录提示信息:"
=""
:.
=""
=""
ExitSub
EndIf
EndIf
If=""Then
'提示用户密码不能为空
MsgBox"密码不能为空!",,"登录提示信息:"
ExitSub
EndIf
If=""Then
MsgBox"请再次输入密码!",,"登录提示信息:"
ExitSub
EndIf
If<>Then
MsgBox"两次输入的密码不一致,请确认!",,"登录提示信
息:"
=""
=""
ExitSub
:.
Else
'添
加新用户
"用户名")=Trim
"密码")=Trim
MsgBox("添加新用户成功,现在您可以登陆系统了!
")
=False
=False
="登录"
="退出"
EndIf
Else
'“登录”按钮,用户登录
DimstrSnoAsString
DimstrSelectAsString
strSno=Trim
'检测用户名是否存在
strSelect="select密码from用户登录信息表where用户
名='"&strSno&"'"
=adCmdText
=strSelect
:.
If=TrueThen
MsgBox"用户名不存在,请重新输入!",,"登录提示信息:
"
=""
=""
ExitSub
EndIf
If"密码")=TrimThen'检测密码是否正确
'UnloadMe
'MsgBox"登陆成功!",,"登录提示信息:"
Else
MsgBox"密码不正确,请重新输入!",,"登录提示信息:"
=""
EndIf
EndIf
EndSub
PrivateSubCommand2_Click()
'“退出”或“取消”按钮
If="取消"Then
=False
:.
=False
="登录"
="退出"
=""
=""
Else
End'UnloadMe
EndIf
EndSub
PrivateSubCommand3_Click()
'“新用户”按钮
=True
=True
=""
=""
=""
="确定"
="取消"
EndSub
PrivateSubCommand3_MouseDown(ButtonAsInteger,ShiftAs
Integer,XAsSingle,YAsSingle)
:.
=True
EndSub
PrivateSubCommand3_MouseUp(ButtonAsInteger,ShiftAsInteger,
XAsSingle,YAsSingle)
=False
EndSub
PrivateSubForm_Load()
=False
=False
EndSub
PrivateSubTimer1_Timer()
'时间time1控件的time事件代码,用来
'显示向左移动的欢迎字幕
If+>0Then'当标签右
边位置大于0时,标签向左移
-80
Else
'否则标签从头开始
=
EndIf
If+>0Then
:.
-80
Else
=
EndIf
EndSub
主界面窗体
如下:
代码:
PrivateSubAddNew_Click()
=True
=False
EndSub
:.
PrivateSubCHKPMCHX_Click()
="出库信息"
DimpmAsString
DimnAsString
pm=InputBox("产品名","请输入",0)
n="select*from出库表where品名='"&pm&"'"
=adCmdText
=n
CallInitGrid1
EndSub
PrivateSubCHKXHCHX_Click()
="出库信息"
DimXHAsString
DimnAsString
XH=InputBox("产品型号","请输入",0)
n="select*from出库表where型号='"&XH&"'"
=adCmdText
=n
EndSub
PrivateSubCKCZ_Click()
'
:.
EndSub
PrivateSubCKJSHR_Click()
="出库信息"
DimJSHRAsString
DimnAsString
JSHR=InputBox("经手人","请输入",0)
n="select*from出库表where经手人='"&JSHR&"'"
=adCmdText
=n
CallInitGrid1
EndSub
PrivateSubCKSHJ_Click()
="出库信息"
DimCHKRQAsString
DimnAsString
CHKRQ=InputBox("出库日期,格式为:月/日/年如:12/1/2011",
"请输入",0)
n="select*from出库表where出库日期='"&CHKRQ&"'"
=adCmdText
=n
CallInitGrid1
:.
EndSub
PrivateSubCKZCX_Click()
="出库信息"
DimZBAsString
ZB="select*from出库表"
=adCmdText
=ZB
CallInitGrid1
EndSub
PrivateSubCommand1_Click()
If=""Then
'提示用户输入用户名
MsgBox"请输入用户名!",,"登录信息提示:"
ExitSub
Else
'
DimusenameAsString
'检测用户名是否已经存在
DimstrSAsString
usename=Trim
strS="select*from用户登录信息表where用户名='"&
usename&"'"
:.
=adCmdText
=strS
If=FalseThen
MsgBox"您输入的用户已存在!",,"登录提示信息:"
=""
=""
=""
ExitSub
EndIf
EndIf
If=""Then
'提示用户密码不能为空
MsgBox"密码不能为空!",,"登录提示信息:"
ExitSub
EndIf
If=""Then
MsgBox"请再次输入密码!",,"登录提示信息:"
ExitSub
EndIf
If<>Then
:.
MsgBox"两次输入的密码不一致,请确认!",,"登录提示信息:
"
=""
=""
ExitSub
Else
'添
加新用户
"用户名")=Trim
"密码")=Trim
DimXAsInteger
X=MsgBox("成功添加新用户,是否要重新登录!",vbYesNo+
vbQuestion+vbDefaultButton1,"提示信息!")
IfX=vbYesThen
UnloadMe
EndIf
'MsgBox("成功添加新用户!")
'=False
'=False
'="登录"
'="退出"
:.
EndIf
=False
=True
=""
="'"
=""
'
EndSub
PrivateSubCommand2_Click()
=False
=True
EndSub
PrivateSubCXDL_Click()
'UnloadMe
EndSub
PrivateSubExit_Click()
End
UnloadForm1
UnloadForm2
UnloadForm3
UnloadForm4
:.
UnloadForm5
UnloadForm6
UnloadForm7
UnloadForm8
EndSub
PrivateSubForm_Load()
TextUserName=TrimUnloadForm1
=False
CallInitGrid0
=-1060
=-560
=
=
EndSub
PrivateSubGHCZ_Click()
'
EndSub
PrivateSubGHPMCX_Click()
="归还信息"
DimpmAsString
DimnAsString
:.
pm=InputBox("产品名","请输入",0)
n="select*from归还表where品名='"&pm&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubGHRCX_Click()
="归还信息"
DimJCRAsString
DimnAsString
JCR=InputBox("归还人","请输入",0)
n="select*from归还表where归还人='"&JCR&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubGHSJCX_Click()
="归还信息"
DimJCRQAsString
DimnAsString
:.
JCRQ=InputBox("归还日期,格式为:月/日/年如:12/1/2011","
请输入",0)
n="select*from归还表where归还日期='"&JCRQ&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubGHXHCX_Click()
="归还信息"
DimXHAsString
DimnAsString
XH=InputBox("产品型号","请输入",0)
n="select*from归还表where型号='"&XH&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubGHZCX_Click()
="归还信息"
DimZBAsString
:.
ZB="select*from归还表"
=adCmdText
=ZB
CallInitGrid2
EndSub
PrivateSubJCCZ_Click()
'
EndSub
PrivateSubJCHPMCHX_Click()
="借出信息"
DimpmAsString
DimnAsString
pm=InputBox("产品名","请输入",0)
n="select*from借出表where品名='"&pm&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubJCHXHCHX_Click()
="借出信息"
:.
DimXHAsString
DimnAsString
XH=InputBox("产品型号","请输入",0)
n="select*from借出表where型号='"&XH&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubJCRCX_Click()
="借出信息"
DimJCRAsString
DimnAsString
JCR=InputBox("借出人","请输入",0)
n="select*from借出表where借出人='"&JCR&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubJCSHJCX_Click()
="借出信息"
DimJCRQAsString
:.
DimnAsString
JCRQ=InputBox("借出日期,格式为:月/日/年如:12/1/2011","
请输入",0)
n="select*from借出表where借出日期='"&JCRQ&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubJCZCX_Click()
="借出信息"
DimZBAsString
ZB="select*from借出表"
=adCmdText
=ZB
CallInitGrid2
EndSub
PrivateSubJSHRCHX_Click()
="归还信息"
DimJSHRAsString
DimnAsString
JSHR=InputBox("经手人","请输入",0)
:.
n="select*from归还表where经手人='"&JSHR&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubJSHRCX_Click()
="借出信息"
DimJSHRAsString
DimnAsString
JSHR=InputBox("经手人","请输入",0)
n="select*from借出表where经手人='"&JSHR&"'"
=adCmdText
=n
CallInitGrid2
EndSub
PrivateSubPMCX_Click()
="库存信息"
DimpmAsString
DimnAsString
pm=InputBox("产品名","请输入",0)
n="select*from库存表where品名='"&pm&"'"
:.
=adCmdText
=n
CallInitGrid0
EndSub
PrivateSubRKCZ_Click()
'
EndSub
PrivateSubRKJSHR_Click()
="入库信息"
DimJSHRAsString
DimnAsString
JSHR=InputBox("经手人","请输入",0)
n="select*from入库表where经手人='"&JSHR&"'"
=adCmdText
=n
CallInitGrid1
EndSub
PrivateSubRKPMCHX_Click()
="入库信息"
DimpmAsString
DimnAsString
:.
pm=InputBox("产品名","请输入",0)
IfLen(pm)>0Then
n="select*from入库表where品名='"&pm&"'"
=adCmdText
=n
EndIf
CallInitGrid1
EndSub
PrivateSubRKSHJ_Click()
="入库信息"
DimRKRQAsString
DimnAsString
RKRQ=InputBox("入库日期,格式为:月/日/年如:12/1/2011","
请输入",0)
n="select*from入库表where入库日期='"&RKRQ&"'"
=adCmdText
=n
CallInitGrid1
EndSub
PrivateSubRKXHCHX_Click()
="入库信息"
:.
DimXHAsString
DimnAsString
XH=InputBox("产品型号","请输入",0)
IfLen(XH)>0Then
n="select*from入库表where型号='"&XH&"'"
=adCmdText
=n
EndIf
CallInitGrid1
EndSub
PrivateSubRKZCX_Click()
="入库信息"
DimZBAsString
ZB="select*from入库表"
=adCmdText
=ZB
CallInitGrid1
EndSub
PrivateSubTimer1_Timer()
If+>0Then'当标签右:.
边位置大于0时,标签向左移
-80
Else
'否则标签从头开始
=
EndIf
If+>0Then
-80
Else
=
EndIf
If+>0Then
-80
Else
=
EndIf
If+>0Then
-80
Else
=
EndIf
EndSub
:.
PrivateSubXGMM_Click()
'
EndSub
PrivateSubXHCX_Click()
="库存信息"
DimXHAsString
DimnAsString
XH=InputBox("产品型号","请输入",0)
IfLen(XH)>0Then'AndVal(XH)<>0
n="select*from库存表where型号='"&XH&"'"
=adCmdText
=n
EndIf
CallInitGrid0
EndSub
PrivateSubZB_Click()
="库存信息"
DimZBAsString
'DimNAsString
'PM=InputBox("产品名","请输入",0)
ZB="select*from库存表"'where品名='"&PM&"'"
:.
=adCmdText
=ZB
CallInitGrid0
EndSub
PrivateSubInitGrid0()
WithDataGrid1
.Columns(0).Width=1600
.Columns(1).Width=2200
.Columns(2).Width=2200
.Columns(3).Width=1000
.Columns(4).Width=1000
.Columns(5).Width=4000
EndWith
EndSub
PrivateSubInitGrid1()
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=4000
EndWith
EndSub
PrivateSubInitGrid2()
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=4000
EndWith
EndSub
:.
用户重新登录界面
代码:
PrivateSubCommand1_Click()
DimstrSnoAsString
DimstrSelectAsString
strSno=Trim
'检测用户名是否存在
strSelect="select密码from用户登录信息表where用户名
='"&strSno&"'"
=adCmdText
=strSelect
If=TrueThen
MsgBox"用户名不存在,请重新输入!",,"登录提示信息:"
=""
:.
=""
ExitSub
EndIf
If"密码")=TrimThen'检测密码是否正确
UnloadMe
'MsgBox"登陆成功!",,"登录提示信息:"
Else
MsgBox"密码不正确,请重新输入!",,"登录提示信息:"
=""
EndIf
EndSub
PrivateSubCommand2_Click()
UnloadMe
EndSub
:.
修改用户密码界面
代码:
PrivateSubCommand1_Click()
IfTrim<>Then
MsgBox"用户名不正确,请确认!",,"信息提示!"
=""
ExitSub
Else
DimnameAsString
DimnamesAsString
name=Trim
names="select*from用户登录信息表where用户名='"&name
&"'"
=adCmdText
=names
:.
If=""Then
MsgBox"请输入旧密码!",,"信息提示!"
ExitSub
EndIf
If"密码