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