仓库标准管理系统VBAccess源代码.doc

资源描述

仓库管理系统项目标建立这是本人利用闲暇之余在VB6.0上制作一个简陋类库管系统，现图文结合方法一步一步展现制作过程。因为本人是个初学者，里面存在很多不足之处望得到高手们指导。此文可作供初学者们学习交流。作者联络方法：E-mail QQ：最终运行效果打开软件出现以下登录界面输入系统预设用户名及密码（ 1 1 ）单击“登录”或单击“新用户”添加新用户进入以下主界面：建立工程 1、创建标准EXE 2、按“打开” 3、添加MDI窗体——打开 4、编辑菜单在空白处右击——点击“菜单编辑器” 在“标题”里输入“系统”，在“名称”里输入“Sys”（注意此处不能为汉字）点击“下一个”再点击“ ” “确定”退到MDI界面点击“系统”——“退出”以下，然后编写代码。代码以下： Private Sub Exit_Click() End End 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 '假如为“确定”则添加新用户 If Text1.Text = "" Then '提醒用户输入用户名 MsgBox "请输入用户名！", , "登录信息提醒：" Exit Sub Else ' Dim usename As String '检测用户名是否已经存在 Dim strS As String usename = Trim(Text1.Text) strS = "select * from 用户登录信息表 where 用户名='" & usename & "'" Adodc1.CommandType = adCmdText Adodc1.RecordSource = strS Adodc1.Refresh If Adodc1.Recordset.EOF = False Then MsgBox "您输入用户已存在!", , "登录提醒信息：" Text1.Text = "" Text2.Text = "" Text3.Text = "" Text1.SetFocus Exit Sub End If End If If Text2.Text = "" Then '提醒用户密码不能为空 MsgBox "密码不能为空!", , "登录提醒信息：" Text2.SetFocus Exit Sub End If If Text3.Text = "" Then MsgBox "请再次输入密码!", , "登录提醒信息：" Text3.SetFocus Exit Sub End If If Text2.Text <> Text3.Text Then MsgBox "两次输入密码不一致,请确定!", , "登录提醒信息：" Text2.Text = "" Text3.Text = "" Text2.SetFocus Exit Sub Else Adodc1.Recordset.AddNew '添加新用户 Adodc1.Recordset.Fields("用户名") = Trim(Text1.Text) Adodc1.Recordset.Fields("密码") = Trim(Text2.Text) Adodc1.Recordset.Update MsgBox ("添加新用户成功，现在您能够登陆系统了！") Label3.Visible = False Text3.Visible = False Command1.Caption = "登录" Command2.Caption = "退出" End If Else '“登录”按钮，用户登录 Dim strSno As String Dim strSelect As String strSno = Trim(Text1.Text) '检测用户名是否存在 strSelect = "select 密码 from 用户登录信息表 where 用户名 = '" & strSno & "'" Adodc1.CommandType = adCmdText Adodc1.RecordSource = strSelect Adodc1.Refresh If Adodc1.Recordset.EOF = True Then MsgBox "用户名不存在，请重新输入！", , "登录提醒信息：" Text1.Text = "" Text2.Text = "" Text1.SetFocus Exit Sub End If If Adodc1.Recordset.Fields("密码") = Trim(Text2.Text) Then '检测密码是否正确 Form1.Hide 'Unload Me Form2.Show 'MsgBox "登陆成功！", , "登录提醒信息：" Else MsgBox "密码不正确，请重新输入！", , "登录提醒信息：" Text2.Text = "" Text2.SetFocus End If End If End Sub Private Sub Command2_Click() '“退出”或“取消”按钮 If Command2.Caption = "取消" Then Label3.Visible = False Text3.Visible = False Command1.Caption = "登录" Command2.Caption = "退出" Text1.Text = "" Text2.Text = "" Text1.SetFocus Else End 'Unload Me End If End Sub Private Sub Command3_Click() '“新用户”按钮 Label3.Visible = True Text3.Visible = True Text1.Text = "" Text2.Text = "" Text3.Text = "" Command1.Caption = "确定" Command2.Caption = "取消" Text1.SetFocus End Sub Private Sub Command3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Label6.Visible = True End Sub Private Sub Command3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Label6.Visible = False End Sub Private Sub Form_Load() Label3.Visible = False Text3.Visible = False End Sub Private Sub Timer1_Timer() '时间time1控件time事件代码，用来 '显示向左移动欢迎字幕 If Label4.Left + Label4.Width > 0 Then '当标签右边位置大于0时，标签向左移 Label4.Move Label4.Left - 80 Else '不然标签从头开始 Label4.Left = Form1.ScaleWidth End If If Label5.Left + Label5.Width > 0 Then Label5.Move Label5.Left - 80 Else Label5.Left = Form1.ScaleWidth End If End Sub 主界面窗体以下：代码： Private Sub AddNew_Click() Frame1.Visible = True Frame2.Visible = False End Sub Private Sub CHKPMCHX_Click() Frame2.Caption = "出库信息" Dim pm As String Dim n As String pm = InputBox("产品名", "请输入", 0) n = "select * from 出库表 where 品名 = '" & pm & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid1 End Sub Private Sub CHKXHCHX_Click() Frame2.Caption = "出库信息" Dim XH As String Dim n As String XH = InputBox("产品型号", "请输入", 0) n = "select * from 出库表 where 型号 = '" & XH & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh End Sub Private Sub CKCZ_Click() 'Form2.Hide Form6.Show End Sub Private Sub CKJSHR_Click() Frame2.Caption = "出库信息" Dim JSHR As String Dim n As String JSHR = InputBox("经手人", "请输入", 0) n = "select * from 出库表 where 经手人 = '" & JSHR & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid1 End Sub Private Sub CKSHJ_Click() Frame2.Caption = "出库信息" Dim CHKRQ As String Dim n As String CHKRQ = InputBox("出库日期，格式为：月/日/年如：12/1/", "请输入", 0) n = "select * from 出库表 where 出库日期 = '" & CHKRQ & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid1 End Sub Private Sub CKZCX_Click() Frame2.Caption = "出库信息" Dim ZB As String ZB = "select * from 出库表 " Adodc2.CommandType = adCmdText Adodc2.RecordSource = ZB Adodc2.Refresh Call InitGrid1 End Sub Private Sub Command1_Click() If Text1.Text = "" Then '提醒用户输入用户名 MsgBox "请输入用户名！", , "登录信息提醒：" Exit Sub Else ' Dim usename As String '检测用户名是否已经存在 Dim strS As String usename = Trim(Text1.Text) strS = "select * from 用户登录信息表 where 用户名='" & usename & "'" Adodc1.CommandType = adCmdText Adodc1.RecordSource = strS Adodc1.Refresh If Adodc1.Recordset.EOF = False Then MsgBox "您输入用户已存在!", , "登录提醒信息：" Text1.Text = "" Text2.Text = "" Text3.Text = "" Text1.SetFocus Exit Sub End If End If If Text2.Text = "" Then '提醒用户密码不能为空 MsgBox "密码不能为空!", , "登录提醒信息：" Text2.SetFocus Exit Sub End If If Text3.Text = "" Then MsgBox "请再次输入密码!", , "登录提醒信息：" Text3.SetFocus Exit Sub End If If Text2.Text <> Text3.Text Then MsgBox "两次输入密码不一致,请确定!", , "登录提醒信息：" Text2.Text = "" Text3.Text = "" Text2.SetFocus Exit Sub Else Adodc1.Recordset.AddNew '添加新用户 Adodc1.Recordset.Fields("用户名") = Trim(Text1.Text) Adodc1.Recordset.Fields("密码") = Trim(Text2.Text) Adodc1.Recordset.Update Dim X As Integer X = MsgBox("成功添加新用户，是否要重新登录!", vbYesNo + vbQuestion + vbDefaultButton1, "提醒信息!") If X = vbYes Then Unload Me Form3.Show End If 'MsgBox ("成功添加新用户！") 'Label3.Visible = False 'Text3.Visible = False 'Command1.Caption = "登录" 'Command2.Caption = "退出" End If Frame1.Visible = False Frame2.Visible = True Text1.Text = "" Text2.Text = "'" Text3.Text = "" 'Form3.Show End Sub Private Sub Command2_Click() Frame1.Visible = False Frame2.Visible = True End Sub Private Sub CXDL_Click() Form3.Show '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(Form1.Text1.Text) Unload Form1 Frame1.Visible = False Call InitGrid0 Me.Height = MDIForm1.Height - 1060 Me.Width = MDIForm1.Width - 560 Me.Top = MDIForm1.Top Me.Left = MDIForm1.Left End Sub Private Sub GHCZ_Click() 'Form2.Hide Form8.Show End Sub Private Sub GHPMCX_Click() Frame2.Caption = "归还信息" Dim pm As String Dim n As String pm = InputBox("产品名", "请输入", 0) n = "select * from 归还表 where 品名 = '" & pm & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub GHRCX_Click() Frame2.Caption = "归还信息" Dim JCR As String Dim n As String JCR = InputBox("归还人", "请输入", 0) n = "select * from 归还表 where 归还人 = '" & JCR & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub GHSJCX_Click() Frame2.Caption = "归还信息" Dim JCRQ As String Dim n As String JCRQ = InputBox("归还日期，格式为：月/日/年如：12/1/", "请输入", 0) n = "select * from 归还表 where 归还日期 = '" & JCRQ & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub GHXHCX_Click() Frame2.Caption = "归还信息" Dim XH As String Dim n As String XH = InputBox("产品型号", "请输入", 0) n = "select * from 归还表 where 型号 = '" & XH & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub GHZCX_Click() Frame2.Caption = "归还信息" Dim ZB As String ZB = "select * from 归还表 " Adodc2.CommandType = adCmdText Adodc2.RecordSource = ZB Adodc2.Refresh Call InitGrid2 End Sub Private Sub JCCZ_Click() 'Form2.Hide Form7.Show End Sub Private Sub JCHPMCHX_Click() Frame2.Caption = "借出信息" Dim pm As String Dim n As String pm = InputBox("产品名", "请输入", 0) n = "select * from 借出表 where 品名 = '" & pm & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub JCHXHCHX_Click() Frame2.Caption = "借出信息" Dim XH As String Dim n As String XH = InputBox("产品型号", "请输入", 0) n = "select * from 借出表 where 型号 = '" & XH & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub JCRCX_Click() Frame2.Caption = "借出信息" Dim JCR As String Dim n As String JCR = InputBox("借出人", "请输入", 0) n = "select * from 借出表 where 借出人 = '" & JCR & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub JCSHJCX_Click() Frame2.Caption = "借出信息" Dim JCRQ As String Dim n As String JCRQ = InputBox("借出日期，格式为：月/日/年如：12/1/", "请输入", 0) n = "select * from 借出表 where 借出日期 = '" & JCRQ & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub JCZCX_Click() Frame2.Caption = "借出信息" Dim ZB As String ZB = "select * from 借出表 " Adodc2.CommandType = adCmdText Adodc2.RecordSource = ZB Adodc2.Refresh Call InitGrid2 End Sub Private Sub JSHRCHX_Click() Frame2.Caption = "归还信息" Dim JSHR As String Dim n As String JSHR = InputBox("经手人", "请输入", 0) n = "select * from 归还表 where 经手人 = '" & JSHR & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub JSHRCX_Click() Frame2.Caption = "借出信息" Dim JSHR As String Dim n As String JSHR = InputBox("经手人", "请输入", 0) n = "select * from 借出表 where 经手人 = '" & JSHR & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid2 End Sub Private Sub PMCX_Click() Frame2.Caption = "库存信息" Dim pm As String Dim n As String pm = InputBox("产品名", "请输入", 0) n = "select * from 库存表 where 品名 = '" & pm & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid0 End Sub Private Sub RKCZ_Click() 'Form2.Hide Form5.Show End Sub Private Sub RKJSHR_Click() Frame2.Caption = "入库信息" Dim JSHR As String Dim n As String JSHR = InputBox("经手人", "请输入", 0) n = "select * from 入库表 where 经手人 = '" & JSHR & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid1 End Sub Private Sub RKPMCHX_Click() Frame2.Caption = "入库信息" Dim pm As String Dim n As String pm = InputBox("产品名", "请输入", 0) If Len(pm) > 0 Then n = "select * from 入库表 where 品名 = '" & pm & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh End If Call InitGrid1 End Sub Private Sub RKSHJ_Click() Frame2.Caption = "入库信息" Dim RKRQ As String Dim n As String RKRQ = InputBox("入库日期，格式为：月/日/年如：12/1/", "请输入", 0) n = "select * from 入库表 where 入库日期 = '" & RKRQ & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh Call InitGrid1 End Sub Private Sub RKXHCHX_Click() Frame2.Caption = "入库信息" Dim XH As String Dim n As String XH = InputBox("产品型号", "请输入", 0) If Len(XH) > 0 Then n = "select * from 入库表 where 型号 = '" & XH & "'" Adodc2.CommandType = adCmdText Adodc2.RecordSource = n Adodc2.Refresh End If Call InitGrid1 End Sub Private Sub RKZCX_Click() Frame2.Caption = "入库信息" Dim ZB As String ZB = "select * from 入库表 " Adodc2.CommandType = adCmdText Adodc2.RecordSource = ZB Adodc2.Refresh Call InitGrid1 End Sub Private Sub Timer1_Timer() If Label4.Left + Label4.Width > 0 Then '当标签右边位置大于0时，标签向

展开阅读全文