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是ag凯发k8国际主页面，添加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等知识，也可以获得本程序的原始代码。
ag凯发k8国际的版权声明：本文内容由互联网用户自发贡献，该文观点仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容， 请发送邮件至 举报，一经查实，本站将立刻删除。