VBA开发的工具管理小软件
科室内的工具比较多,比如专用笔记本电脑,兆欧表,万用表,电缆反射仪,光纤衰减率测试仪等等。自己科室人员或其他科室人员经常借用,有时工作忙,一些人忘记了归还,用纸质的台账记录,不容易查询,也不容易管理。于是就简单用VBA开发了一个简单的工具管理小软件,方便管理。
相关功能包括台账录入,工具借出,工具归还,台账查询,借用记录查询。另外就是购买了条形码打印机和扫码枪,方便信息录入。针对每个工具,进行编码,用条形码打印机打印出来帖到工具上,借用或归还时,用扫码枪扫描即可,方便快捷。
主界面见图1。
图1:工具管理主界面
一、功能说明
1. 工具录入,需要登录密码,登录之后,需要录入条形码,工具名称,型号,采购数量等信息;
2. 工具借出,如果已经拿到工具,可以扫码录入借出信息,也可以根据工具名称查询。
查询到有库存时,则弹出借用信息录入窗口, 如下图。
3. 工具归还,因为已经拿到工具,直接扫码归还即可。
4. 工具清单查询,可以显示库存数量和采购数量等信息。
5. 查看借用情况,具体如下表所示。
二、开发过程及代码
ALT F11进入VBA编译器界面。
依次插入如下窗体,并对窗体编写VBA代码进行控制:
窗体UserForm8,如下图,用于管理员登录,录入工具信息。
点击确认按钮,进入窗体代码编译,输入如下代码。
Private Sub CommandButton1_Click()‘输入密码,若密码正确,则显示窗体UserForm1。否则重新输入密码。
If UserForm8.TextBox1.Value = "123456" Then
UserForm1.Show
Else
MsgBox ("请输入正确密码!")
End If
End Sub
Private Sub CommandButton2_Click()‘点击取消按钮,则关闭UserForm8窗体。
Unload UserForm8
End Sub
窗体UserForm1用于录入工具信息,如下所示。点击确认按钮,进入窗体代码录入界面,输入如下代码。
Private Sub CommandButton1_Click()’若二维码已经存在,则提示已经录入。否则则在sheet1表格中录入工具信息。
Row = Sheet1.Range("a65536").End(xlUp).Row 1
Find = False
For i = 2 To Row
If Sheet1.Cells(i, 1) = UserForm1.TextBox1.Value Then
MsgBox ("这个二维码已经录入!")
Find = True
Exit For
End If
Next i
If Find = False Then
Sheet1.Cells(Row, 1) = UserForm1.TextBox1.Value
Sheet1.Cells(Row, 2) = UserForm1.TextBox2.Value
Sheet1.Cells(Row, 3) = UserForm1.TextBox3.Value
Sheet1.Cells(Row, 4) = UserForm1.TextBox3.Value
Sheet1.Cells(Row, 5) = UserForm1.TextBox4.Value
MsgBox "已经录入"
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm1
End Sub
窗体UserForm2,通过扫码查询,或者通过工具名称查询,若库存为0,则无法借出工具。
代码如下:
Private Sub CommandButton1_Click()
item1 = UserForm2.TextBox1.Value
item2 = UserForm2.TextBox2.Value
If item2 = Null Or item2 = "" Then
item2 = "工具管理系统"
End If
If item1 = Null Or item1 = "" Then
item1 = "工具管理系统"
End If
item1 = Replace(item1, " ", "")
Row = Sheet1.Range("a65536").End(xlUp).Row
Find = False
j = 1
For i = 2 To Row
temp1 = Sheet1.Cells(i, 1)
temp2 = Sheet1.Cells(i, 2)
temp1 = Replace(temp1, " ", "")
If StrComp(temp1, item1) = 0 And Sheet1.Cells(i, 4) > 0 Then
Find = True
j = i
MsgBox "库存是:" & Sheet1.Cells(i, 4)
Exit For
End If
If (InStr(temp2, item2) > 0) And Sheet1.Cells(i, 4) > 0 Then
Find = True
j = i
MsgBox "库存是:" & Sheet1.Cells(i, 4)
Exit For
End If
Next i
If Find = False Then
MsgBox "库存是:0"
Else’若库存不为零,则把工具信息显示到UserForm3中。
UserForm3.Label2.Caption = Sheet1.Cells(j, 2)
UserForm3.Label5.Caption = Sheet1.Cells(j, 3)
UserForm3.Label6.Caption = Sheet1.Cells(j, 4)
UserForm3.Label11.Caption = Sheet1.Cells(j, 1)
UserForm3.Show
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm2
End Sub
工具借出信息录入窗体UserForm3,sheet2表格用于存放工具借出和归还信息。
Private Sub CommandButton1_Click()
Row1 = Sheet1.Range("a65536").End(xlUp).Row 1
For i = 2 To Row1
If Sheet1.Cells(i, 1) = UserForm3.Label11.Caption Then
rest = CInt(Sheet1.Cells(i, 4)) – CInt(UserForm3.TextBox2.Value)
If rest < 0 Then
MsgBox ("借出数量太多,超出了库存")
Exit Sub
Else
Sheet1.Cells(i, 4) = rest
End If
End If
Next i
Row = Sheet2.Range("a65536").End(xlUp).Row 1
Sheet2.Cells(Row, 1) = UserForm3.Label11.Caption
Sheet2.Cells(Row, 2) = UserForm3.Label2.Caption
Sheet2.Cells(Row, 3) = UserForm3.TextBox1.Value
Sheet2.Cells(Row, 4) = UserForm3.DTPicker1.Value
Sheet2.Cells(Row, 5) = UserForm3.DTPicker2.Value
Sheet2.Cells(Row, 6) = UserForm3.TextBox2.Value
Sheet2.Cells(Row, 7) = "否"
If Trim(UserForm3.TextBox1.Value) = "" Then
MsgBox ("请录入借用人")
Exit Sub
End If
MsgBox ("借出成功,请及时归还")
Unload UserForm3
End Sub
Private Sub CommandButton2_Click()
Unload UserForm3
End Sub
Private Sub UserForm_Initialize()
UserForm3.DTPicker1.Value = Date
UserForm3.DTPicker2.Value = Date
End Sub
工具归还窗体UserForm4用于归还工具信息录入,扫码录入并添加归还人。主要查找到对应的工具,并把该工具库存数量增加1。
Private Sub CommandButton1_Click()
Item = UserForm4.TextBox1.Value
backer = UserForm4.TextBox2.Value
If Trim(Item) <> "" And Trim(backer) <> "" Then
Row1 = Sheet3.Range("a65536").End(xlUp).Row 1
Sheet3.Cells(Row1, 1) = Item
Sheet3.Cells(Row1, 2) = backer
Sheet3.Cells(Row1, 3) = UserForm4.DTPicker1.Value
Row = Sheet1.Range("a65536").End(xlUp).Row 1
success = False
For i = 2 To Row
If Str(Sheet1.Cells(i, 1)) = Str(Item) Then
Sheet1.Cells(i, 4) = CInt(Sheet1.Cells(i, 4)) 1
success = True
Exit For
End If
Next i
Row = Sheet2.Range("a65536").End(xlUp).Row 1
success1 = False
For i = 2 To Row
If Str(Sheet2.Cells(i, 1)) = Str(Item) And Sheet2.Cells(i, 7) <> "是" Then
Sheet2.Cells(i, 7) = "是"
success1 = True
Exit For
End If
Next i
If success = True And success1 = True Then
MsgBox ("归还成功")
ThisWorkbook.Save
Unload UserForm4
Else
MsgBox ("归还失败")
End If
Else
MsgBox ("请正确录入信息")
End If
End Sub
Private Sub CommandButton2_Click()
Unload UserForm4
End Sub
Private Sub UserForm_Initialize()
UserForm4.DTPicker1.Value = Date
End Sub
窗体UserForm5是主页面,添加5个按钮,相关代码如下,用于打开对应的窗体:
Private Sub CommandButton1_Click()
UserForm8.Show
End Sub
Private Sub CommandButton2_Click()
UserForm2.Show
End Sub
Private Sub CommandButton3_Click()
UserForm4.Show
End Sub
Private Sub CommandButton4_Click()
UserForm6.Show
End Sub
Private Sub CommandButton5_Click()
UserForm7.Show
End Sub
Private Sub UserForm_Terminate()
ThisWorkbook.Close
End Sub
窗体UserForm6用于显示工具清单及库存情况。用控件listview进行显示。
Private Sub UserForm_Initialize()
Call init_ListView_head
Call init_form
End Sub
Sub init_listview_head()
ListView1.ColumnHeaders.Add 1, , Sheet1.Cells(1, 1), 60
ListView1.ColumnHeaders.Add 2, , Sheet1.Cells(1, 2), 100
ListView1.ColumnHeaders.Add 3, , Sheet1.Cells(1, 3), 65
ListView1.ColumnHeaders.Add 4, , Sheet1.Cells(1, 4), 65
ListView1.ColumnHeaders.Add 5, , Sheet1.Cells(1, 5), 100
ListView1.FullRowSelect = True
ListView1.View = lvwReport
ListView1.Gridlines = True
End Sub
Sub init_form()
ListView1.ListItems.Clear
Row = Sheet1.Range("a65536").End(xlUp).Row 1
For i = 2 To Row
With ListView1.ListItems.Add
.Text = Sheet1.Cells(i, 1)
.SubItems(1) = Sheet1.Cells(i, 2)
.SubItems(2) = Sheet1.Cells(i, 3)
.SubItems(3) = Sheet1.Cells(i, 4)
.SubItems(4) = Sheet1.Cells(i, 5)
End With
Next i
End Sub
窗体UserForm7用于显示借出和归还工具的清单,同样用控件listview进行显示。
Private Sub UserForm_Initialize()
Call init_listview_head
Call init_form
End Sub
Sub init_listview_head()
ListView1.ColumnHeaders.Add 1, , Sheet2.Cells(1, 1), 100
ListView1.ColumnHeaders.Add 2, , Sheet2.Cells(1, 2), 100
ListView1.ColumnHeaders.Add 3, , Sheet2.Cells(1, 3), 65
ListView1.ColumnHeaders.Add 4, , Sheet2.Cells(1, 4), 65
ListView1.ColumnHeaders.Add 5, , Sheet2.Cells(1, 5), 65
ListView1.ColumnHeaders.Add 6, , Sheet2.Cells(1, 6), 65
ListView1.ColumnHeaders.Add 7, , Sheet2.Cells(1, 7), 65
ListView1.FullRowSelect = True
ListView1.View = lvwReport
ListView1.Gridlines = True
End Sub
Sub init_form()
ListView1.ListItems.Clear
Row = Sheet2.Range("a65536").End(xlUp).Row 1
For i = 2 To Row
With ListView1.ListItems.Add
.Text = Sheet2.Cells(i, 1)
.SubItems(1) = Sheet2.Cells(i, 2)
.SubItems(2) = Sheet2.Cells(i, 3)
.SubItems(3) = Sheet2.Cells(i, 4)
.SubItems(4) = Sheet2.Cells(i, 5)
.SubItems(5) = Sheet2.Cells(i, 6)
.SubItems(6) = Sheet2.Cells(i, 7)
End With
Next i
End Sub
下面的一段代码,用于打开excel表格,直接进入主窗体界面。需要在ThisWorkbook中添加。
若对代码加以保护,则在菜单->工具->VBA Project属性,打开如下窗口。打开保护页,选择“查看时锁定工程”,并在输入密码。
目前开发的功能可以使用,因为开发的比较快(一个上午),仍有一些地方需要完善,比如可以用ACCESS管理数据,这样就可以搞成类似与CS结构的软件了。虽然VBA已经比较落伍了,但有时还是比较方便的,尤其对于无法安装其他开发环境的电脑,方便快捷,非专业人员容易上手。
私信可交流EXCEL,VBA等知识,也可以获得本程序的原始代码。
版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容, 请发送邮件至 举报,一经查实,本站将立刻删除。