VB 编写的 文档管理系统

首先还是看一下：要实现的用户的界面：

看到EXCEL 是从B3 开始扫描的：

所以用 alt + F11 打开程序就发现：

看到sheet1 中的代码：

Option Explicit

'****************************************

'“借阅人”单元格内容有改变时对应事件代码

'****************************************

Private Sub Worksheet_Change(ByVal TargetAs Range)

   Dim I As Long, J As Integer

   Dim strTemp1 As String

   Dim Bfind As Boolean

   

    J= Target.Column '取得内容改变单元格的列号

    '判断用户所选择单元格区域，如果不只选择了一个单元格，或者所选择的

    '单元格列不是“借阅人”列，或者所选择的单元格内容为空，都可以中断

    '执行过程

   If Target.Count > 1 Or J <> 11 Then

       Exit Sub

   Else

       '不能并列3条件，是因为单元格数量大于1时，Target.Value会报错

       If Trim(Target.Value) = "" Then

           '清空借出日期、归还日期、借阅人的信息

           ActiveSheet.Range(Target.Offset(0, -2).Address & ":" &Target.Address).Value = ""

           Exit Sub

       End If

   End If

   

 

    '取得“借阅人”列对应的同一行、前七列单元格的数值，即“项目编号”

   strTemp1 = Trim(Target.Offset(0, -7).Value)

    '取得“项目编号”中包含的项目密级的信息

   strTemp1 = Mid(strTemp1, 4, 1)

    '将员工可以借阅项目资料的权限设置表赋予变量“wkSheet1”

   Set wkSheet1 = ThisWorkbook.Worksheets("借阅权限")

   Bfind = False

    '循环查找借阅人可以借阅项目资料的密级

   For I = 2 To wkSheet1.Range("a1048576").End(xlUp).Row

       If Trim(wkSheet1.Cells(I, 2).Value) = Trim(Target.Value) Then

           '如果项目编号中包含的密级大于借阅人可以借阅的密级，则借阅人

           '不能借阅该项目资料，给出警示，并将借阅日期、归还日期、借阅人

           '３个单元格清空

           Bfind = True

           If strTemp1 > wkSheet1.Cells(I, 4) Then

                '警示借阅权限不够

                MsgBox "该员工没有借阅此项目资料的权限！"

                '清空借阅日期单元格

                Target.Offset(0, -2).Value =""

                '清空归还日期单元格

                Target.Offset(0, -1).Value =""

                '清空借阅人单元格

                Target.Value = ""

                Exit For '跳出循环

               

           End If

       End If

   Next

   If Bfind = False Then

       '警示借阅权限不够

       MsgBox "该员工没有借阅此项目资料的权限！"

       Target.Value = ""

   End If

   

End Sub

 

顺便看一下sheet2 中的代码：

Option Explicit

 

 

Private Sub Worksheet_Change(ByVal TargetAs Range)

 

End Sub

 

Private Sub Worksheet_SelectionChange(ByValTarget As Range)

 

End Sub

好，下面看一下操作方法：

先把 excel 中的table copy一下：

Copy 到一个新的 excel 2007 中：

再在第一行 insert 文本：

写好：”已归档”，“未归档”, “ 全部显示” 等。

再右键这个图标：

点击指定宏：

这个时候，你就要去 insert 的模板中添加刚才添加的 模板：

下面列一下全部的“模板” 中的代码：

Option Explicit

Public wkSheet1 As Worksheet

'****************************************

'单击“已归档”按钮对应过程代码

'****************************************

Sub 已归档_单击()

    '关闭自动筛选

   ActiveSheet.AutoFilterMode = False

   Range("B3").Select    '选择表格的左上角单元格

   Selection.AutoFilter    '给单元格设置自动筛选

    '筛选出“已归档”列不为空的单元格

   Selection.AutoFilter Field:=6, Criteria1:="<>"

 

End Sub

'****************************************

'单击“未归还”按钮对应过程代码

'****************************************

Sub 未归还_单击()

    '关闭自动筛选

   ActiveSheet.AutoFilterMode = False

   Range("B3").Select '选择表格的左上角单元格

   Selection.AutoFilter '给单元格设置自动筛选

    '筛选出“借出日期”列不为空的单元格

   Selection.AutoFilter Field:=8, Criteria1:="<>"

    '筛选出“归还日期”列为空的单元格

   Selection.AutoFilter Field:=9, Criteria1:="="

End Sub

'****************************************

'单击“超期未归还”按钮对应过程代码

'****************************************

Sub 超期未归还_单击()

   

    '关闭自动筛选

   ActiveSheet.AutoFilterMode = False

   Range("B3").Select '选择表格的左上角单元格

   Selection.AutoFilter '给单元格设置自动筛选

    '筛选出“借出日期”列中单元格数值小于当前日期减去３０天对应的日期

    '即可得到借阅期限超出３０天的借阅记录

   Selection.AutoFilter Field:=8, Criteria1:="<" & Now -30 & ""

    '筛选出“归还日期”列为空的单元格

   Selection.AutoFilter Field:=9, Criteria1:="="

   

End Sub

'****************************************

'单击“全部显示”按钮对应过程代码

'****************************************

Sub 全部显示_单击()

    '关闭自动筛选

   ActiveSheet.AutoFilterMode = False

End Sub

 

'****************************************

'单击“未归档”按钮对应过程代码

'****************************************

Sub 未归档_单击()

    '关闭自动筛选

   ActiveSheet.AutoFilterMode = False

   Range("B3").Select '选择表格的左上角单元格

   Selection.AutoFilter '给单元格设置自动筛选

    '筛选出“未归档”列不为空的单元格

   Selection.AutoFilter Field:=6, Criteria1:="="

 

End Sub

 

另外说明一下：

还有一个sheet: