|
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已经比较落伍了，但有时还是比较方便的，尤其对于无法安装其他开发环境的电脑，方便快捷，非专业人员容易上手。 |
|
|
