网盘应用—Excel数据库开发：[7]圆满收官

1、Worksheet_SelectionChange事件程序设计

实现功能：如果选择了一个包含多个单元格的区域，则将所选择区域的范围缩小到仅左上角一个单元格，将该单元格的值通过Bval全局变量传递给

Worksheet_Change事件。程序代码如下：

Public Bval '编辑前的值

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If DNDST = 0 Then   '“免打扰”已撤除的情况下才触发该事件

   If Selection.Cells.Count > 1 Then

      Cells(Target.Row, Target.Column).Select

   End If

   Bval = Cells(Target.Row, Target.Column).Value

End If

End Sub

2、Worksheet_Change事件程序设计：环境初始化

Private Sub Worksheet_Change(ByVal Target As Range)

If DNDST = 0 Then '“免打扰”已撤除的情况下才触发事件

 Application.EnableEvents = False '禁止事件递归调用

 Dim EndRow As Single  '最后一行的行号

 EndRow = Range("a65535").End(xlUp).Row

 If Target.Column > 4 And Target.Column < 7 And _

      Target.Row > 1 And Target.Row <= EndRow And _

        Target.Cells.Count = 1 Then '限定触发范围为可编辑区域

   Dim erow, ecol As Long, DBrow As Integer

   Dim Wr As Byte  '是否写入数据库的标志

   Dim Eval As Variant '编辑后的值

   erow = Target.Row: ecol = Target.Column

   DBrow = Cells(erow, 9): Wr = 1

   Eval = Cells(erow, ecol).Value

'......

End Sub

3、Worksheet_Change事件程序设计：判别输入数据有效性、单元格是否有变化

Private Sub Worksheet_Change(ByVal Target As Range)

'......

   If ecol = 5 And Eval <> "" Then

      If IsDate(Eval) = True Then

         If Eval < Cells(erow, 3) Then

            MsgBox "“" & Eval & "”" & "完成时间不能在通知时间以先！", _

               vbOKOnly, "请输入有效日期，例如：“2015-1-31”"

            Wr = 0

         Else

            If Eval > Date Then

               MsgBox "“" & Eval & "”" & "完成时间不能大于今天！今天是" _

                  & Date, vbOKOnly, "请输入有效日期，例如：“2015-1-31”"

               Wr = 0

            End If

         End If

      Else

         MsgBox "“" & Eval & "”" & "不是一个有效的日期！", _

            vbOKOnly, "请输入有效日期，例如：“2015-1-31”"

         Wr = 0

      End If

   End If

   If Bval = Eval Then Wr = 0

   If Wr = 0 Then '无需写入数据库

      Cells(erow, ecol) = Bval

      GoTo Ex  '退出

   End If

'......

End Sub

4、Worksheet_Change事件程序设计：写入数据库

Private Sub Worksheet_Change(ByVal Target As Range)

'......  

Application.ScreenUpdating = False

   Application.ShowWindowsInTaskbar = False

   Dim DB As String

   DB = "d:\kp\远程工单\远程工单数据库.xls"

   Do

   If Dir(DB) <> "" Then

      Workbooks.Open Filename:=DB, Password:="111"

   Else

      MsgBox "连接数据库失败！" & vbCrLf & vbCrLf & DB & "不存在！"

      GoTo Ex

   End If

   Workbooks("远程工单数据库.xls").Sheets(1).Cells(DBrow, ecol) = Eval

   Application.DisplayAlerts = False

   Workbooks("远程工单数据库.xls").Close savechanges:=True

   Application.DisplayAlerts = True

   If Dir(DB & "*冲突*.*") <> "" Then

      Kill (DB & "*冲突*.*")

   Else

      Exit Do

   End If

   Loop

'......

End Sub

5、Worksheet_Change事件程序设计：重新分类标色

Private Sub Worksheet_Change(ByVal Target As Range)

'......  

   Application.StatusBar = Cells(erow, 1).Value & "号工单“" & _

      Trim(Left(Cells(1, ecol).Value, 6)) & "”的修改写入数据库！"

   If ecol = 5 Then

      If Cells(erow, 5) >= Cells(erow, 3) Then '完成白色

            Sheets(1).Unprotect ("111")

            Cells(erow, 4).Interior.ColorIndex = 2

      Else

         If Cells(erow, 4) < Date Then           '过期红色

            Sheets(1).Unprotect ("111")

            Cells(erow, 4).Interior.ColorIndex = 3

         Else                                      '未完成未过期绿色

            Sheets(1).Unprotect ("111")

            Cells(erow, 4).Interior.ColorIndex = 43

         End If

      End If

   End If

   Sheets(1).Protect ("111")

 End If

'......

End Sub

6、Worksheet_Change事件程序设计：恢复默认环境

Private Sub Worksheet_Change(ByVal Target As Range)

'......  

Ex:

 Application.ShowWindowsInTaskbar = True

 Application.ScreenUpdating = True

 Application.EnableEvents = True

End If

End Sub

7、至此，以酷盘为传输媒介的远程工单系统设计制作完成，感谢朋友们的鼓励支持。读程序是很辛苦的，好在系统终于设计完工了，请朋友们下载作为学习的参考资料。下载地址：

http://pan.baidu.com/s/1pJJW6pX  

（待续。。。）

下期预告：下期是此系列经验的最后一期，我们将对远程工单系统做一次全面测试。敬请期待！