仓库管理系统

项目的建立

这是本人利用闲暇之余在VB6.0上制作的一个简陋的类库管系统，现图文结合的方式一步一步展现制作过程。由于本人是个初学者，里面存在很多不足之处望得到高手们的指导。此文可作供初学者们学习交流。作者联系方式：E-mail

最终运行效果

打开软件出现如下登录界面

输入系统预设用户名及密码（ 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

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

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

MsgBox "用户名不存在，请重新输入！", , "登录提示信息："

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

Exit Sub

End If

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/2011", "请输入", 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

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

e

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()

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/2011", "请输入", 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/2011", "请输入", 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/2011", "请输入", 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时，标签向左移

Label4.Move Label4.Left - 80

Else '否则标签从头开始

Label4.Left = Form2.ScaleWidth

End If

If Label5.Left + Label5.Width > 0 Then

Label5.Move Label5.Left - 80

Else

Label5.Left = Form2.ScaleWidth

End If

If Label6.Left + Label6.Width > 0 Then

Label6.Move Label6.Left - 80

Else

Label6.Left = Form2.ScaleWidth

End If

If Label7.Left + Label7.Width > 0 Then

Label7.Move Label7.Left - 80

Else

Label7.Left = Form2.ScaleWidth

End If

End Sub

Private Sub XGMM_Click()

'Form2.Hide

Form4.Show

End Sub

Private Sub XHCX_Click()

Frame2.Caption = "库存信息"

Dim XH As String

Dim n As String

XH = InputBox("产品型号", "请输入", 0)

If Len(XH) > 0 Then 'And Val(XH) <> 0

n = "select * from 库存表 where 型号 = '" & XH & "'"

Adodc2.CommandType = adCmdText

Adodc2.RecordSource = n

Adodc2.Refresh

End If

Call InitGrid0

End Sub

Private Sub ZB_Click()

Frame2.Caption = "库存信息"

Dim ZB As String

'Dim N As String

'PM = InputBox("产品名", "请输入", 0)

ZB = "select * from 库存表 " 'where 品名 = '" & PM & "'"

Adodc2.CommandType = adCmdText

Adodc2.RecordSource = ZB

Adodc2.Refresh

Call InitGrid0

End Sub

Private 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 = 4000

End With

End Sub

Private Sub InitGrid1()

With DataGrid1

.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

End With

End Sub

Private Sub InitGrid2()

With DataGrid1

'.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

End With

End Sub

用户重新登录界面

代码：

Private Sub Command1_Click()

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

MsgBox "用户名不存在，请重新输入！", , "登录提示信息："

Text1.Text = ""

Text2.Text = ""

Text1.SetFocus

Exit Sub

End If

Unload Me

Form2.Show

'MsgBox "登陆成功！", , "登录提示信息："

Else

MsgBox "密码不正确，请重新输入！", , "登录提示信息："

Text2.Text = ""

Text2.SetFocus

End If

End Sub

Private Sub Command2_Click()

Unload Me

Form2.Show

End Sub

修改用户密码界面

代码：

Private Sub Command1_Click()

If Trim(Text1.Text) <> Form2.TextUserName Then

MsgBox "用户名不正确，请确认！", , "信息提示！"

Text1.Text = ""

Text1.SetFocus

Exit Sub

Else

Dim name As String

Dim names As String

name = Trim(Text1.Text)

names = "select * from 用户登录信息表 where 用户名='" & name & "'"

Adodc1.CommandType = adCmdText

Adodc1.RecordSource = names

Adodc1.Refresh

If Text2.Text = "" Then

MsgBox "请输入旧密码!", , "信息提示！"

Text2.SetFocus

Exit Sub

End If

MsgBox "旧密码不正确，请确认!", , "信息提示！"

Text2.Text = ""

Text2.SetFocus

Exit Sub

End If

If Text3.Text = "" Then

MsgBox "请输入新密码!", , "信息提示！"

Text3.SetFocus

Exit Sub

End If

If Text4.Text = "" Then

MsgBox "请再次输入新密码!", , "信息提示！"

Text4.SetFocus

Exit Sub

End If

If Trim(Text3.Text) <> Trim(Text4.Text) Then

MsgBox "两次输入的新密码不一致!", , "信息提示！"

Text3.Text = ""

Text4.Text = ""

Text3.SetFocus

Exit Sub

Else

MsgBox ("密码修改成功！")

Unload Me

'Form2.Show

End If

End If

End Sub

Private Sub Command2_Click()

Unload Me

'Form2.Show

End Sub

入库管理

代码：

Private Sub Command1_Click()

If Text1.Text = "" And Text2.Text = "" Then

MsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"

Exit Sub

Text1.SetFocus

Else

If Text3.Text = "" And Text4.Text = "" Then

MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"

Text3.SetFocus

Exit Sub

End If

If Text5.Text = "" Then

MsgBox "请经手人签名!", vbCritical, "提示信息!"

Text5.SetFocus

Exit Sub

End If

Adodc1.Refresh

End If

Dim pm As String

Dim pms As String

Dim n As String

Dim m As String

pm = Trim(Text1.Text)

n = Val(Text3.Text)

pms = "select * from 库存表 where 品名='" & pm & "'"

With Form2

End With

Else

End If

End If

Dim X As Integer

X = MsgBox("产品入库登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!")

If X = vbNo Then

Unload Me

'Form2.Show

Else

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text1.SetFocus

End If

Dim ZB As String

ZB = "select * from 入库表 " 'where 品名 = '" & PM & "'"

End Sub

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Text5.Text = ""

Text6.Text = ""

Text7.Text = ""

Text1.SetFocus

End Sub

Private Sub Command3_Click()

Unload Me

'Form2.Show

End Sub

出库管理

代码：

Private Sub Command1_Click()

If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" Then

MsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"

Exit Sub

Else

If Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" Then

MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"

Text2.SetFocus

Exit Sub

End If

If Text2.Text = "" Then

MsgBox "请经手人签名!", vbCritical, "提示信息!"

Text2.SetFocus

Exit Sub

End If

Adodc1.Refresh

End If

Dim pm As String

Dim pms As String

Dim n As String

Dim m As String

pm = Trim(Combo1.Text)

n = Val(Text1.Text)

pms = "select * from 库存表 where 品名='" & pm & "'"

End If

Dim X As Integer

X = MsgBox("产品出库登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!")

If X = vbNo Then

Unload Me

'Form2.Show

End If

Combo1.Text = ""

Combo2.Text = ""

Combo3.Text = ""

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Dim ZB As String

ZB = "select * from 出库表 " 'where 品名 = '" & PM & "'"

End Sub

Private Sub Command2_Click()

Combo1.Text = ""

Combo2.Text = ""

Combo3.Text = ""

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

End Sub

Private Sub Command3_Click()

Unload Me

'Form2.Show

End Sub

Private Sub Form_Load()

Adodc2.Refresh

Loop

End Sub

借出管理

代码：

Private Sub Command1_Click()

If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" Then

MsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"

Exit Sub

Else

If Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" Then

MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"

Text1.SetFocus

Exit Sub

End If

If Text2.Text = "" Then

MsgBox "请经手人签名!", vbCritical, "提示信息!"

Text2.SetFocus

Exit Sub

End If

Adodc1.Refresh

End If

Dim pm As String

Dim pms As String

Dim n As String

Dim m As String

pm = Trim(Combo1.Text)

n = Val(Text1.Text)

pms = "select * from 库存表 where 品名='" & pm & "'"

End If

Dim X As Integer

X = MsgBox("产品借出登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!")

If X = vbNo Then

Unload Me

Form2.Show

End If

Combo1.Text = ""

Combo2.Text = ""

Combo3.Text = ""

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Dim ZB As String

ZB = "select * from 借出表 " 'where 品名 = '" & PM & "'"

End Sub

Private Sub Command2_Click()

Combo1.Text = ""

Combo2.Text = ""

Combo3.Text = ""

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

End Sub

Private Sub Command3_Click()

Unload Me

Form2.Show

End Sub

Private Sub Form_Load()

Adodc2.Refresh

Loop

End Sub

归还管理

代码：

Private Sub Command1_Click()

If Combo1.Text = "" And Combo2.Text = "" Then ' text1.Text = "" And Text2.Text = "" Then

MsgBox "“品名”和“型号”不能同时为空，必须输入其中一项!", , "提示信息!"

Exit Sub

Else

If Text1.Text = "" And Combo3.Text = "" Then ' Text4.Text = "" Then

MsgBox "请输入产品“数量”或“单位”之一!", , "提示信息!"

Text1.SetFocus

Exit Sub

End If

If Text2.Text = "" Then

MsgBox "请经手人签名!", vbCritical, "提示信息!"

Text2.SetFocus

Exit Sub

End If

If Text3.Text = "" Then

MsgBox "请输入归还人姓名!", vbCritical, "提示信息!"

Text3.SetFocus

Exit Sub

End If

Adodc1.Refresh

End If

Dim pm As String

Dim pms As String

Dim n As String

Dim m As String

pm = Trim(Combo1.Text)

n = Val(Text1.Text)

pms = "select * from 库存表 where 品名='" & pm & "'"

End If

Dim X As Integer

X = MsgBox("产品归还登记成功，是否继续添加产品!", vbYesNo + vbQuestion + vbDefaultButton1, "提示信息!")

If X = vbNo Then

Unload Me

Form2.Show

End If

Combo1.Text = ""

Combo2.Text = ""

Combo3.Text = ""

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

Dim ZB As String

ZB = "select * from 归还表 " 'where 品名 = '" & PM & "'"

End Sub

Private Sub Command2_Click()

Combo1.Text = ""

Combo2.Text = ""

Combo3.Text = ""

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

End Sub

Private Sub Command3_Click()

Unload Me

Form2.Show

End Sub

Private Sub Form_Load()

' Dim i As String

' i = 0

' Adodc2.Refresh

' 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

Adodc2.Refresh

i = i + 1

Loop

D = Split(a, ",")

If j < i Then

s = D(2)

Combo1.AddItem s

'k = 0

'If k < j And D(k) <> D(j) Then

'If D(k) <> D(j) Then

' Combo1.AddItem D(j)

' k = k + 1

' Else

' k = k + 1

'End If

'End If

j = j + 1

End If

Text5.Text = s 'a + "," + D(2) + D(1) '+ " " + Val(i) + " " + Val(j) + " " + Val(k)

Text6.Text = j

'Combo1.AddItem D(1)

End Sub

本文来源：https://www.2haoxitong.net/k/doc/6d3d625803d276a20029bd64783e0912a2167cb6.html