网盘应用—Excel数据库开发：[6]指日告罄

1、建立模块

该模块被Workbook_Open事件、命令按钮Click事件调用，完成删除客户端数据、将数据库中的数据复制到客户端、设置格式等功能。

打开“远程工单派发单位客户端.xls”，Alt+F11打开VBA窗口，如图示插入模块，双击刚插入的模块1，在右边的代码窗口中输入代码。

2、打开数据库、数据库的数据读入数组、关闭数据库

Public DNDST As Byte ‘定义一个全局变量传递给Worksheet_Change事件

Sub 更新本地数据()   

DNDST = 1  '免打扰--屏蔽Worksheet_Change事件

   Application.ScreenUpdating = False

   Dim DB As String

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

   If Dir(DB) <> "" Then

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

   Else

      MsgBox "连接数据库失败！" & vbCrLf & vbCrLf & _

         "文件“d:\kp\远程工单\远程工单数据库.xls”不存在！"

      Application.DisplayAlerts = False

      ThisWorkbook.Application.Quit

   End If

   With ThisWorkbook.Sheets(1)

   arr1 = Workbooks("远程工单数据库.xls").Sheets(1).UsedRange.Value

   Application.DisplayAlerts = False

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

   Application.DisplayAlerts = True

'......

End Sub

3、清空本地数据，从数组中筛选登录用户工单记录，写入本地客户端

Sub 更新本地数据()   

'......

   ReDim arr2(1 To UBound(arr1), 1 To 9)

   i2 = 1 'arr2行标变量

   For i = 2 To UBound(arr1)

      If arr1(i, 2) = F1.dwmc Then

         For j = 1 To UBound(arr1, 2)

            arr2(i2, j) = arr1(i, j)

         Next j

         arr2(i2, 9) = i

         i2 = i2 + 1

      End If

   Next i

   Erase arr1

   'Sheets(1).Unprotect ("111")

   .Rows("2:65535").Delete

   .Range(Cells(2, 1), Cells(i2 + 1, 9)) = arr2

   Erase arr2

   Application.StatusBar = "连接数据库成功，本地数据已更新！"

   End With

'......

End Sub

4、设置格式

Sub 更新本地数据()   

'......

   If i2 > 1 Then

   With ThisWorkbook.Sheets(1).UsedRange.Offset(1)

      With .Resize(.Rows.Count - 1)

      .Borders.LineStyle = xlContinuous

      .VerticalAlignment = xlCenter

      .WrapText = True

      End With

   End With

   End If

'......

End Sub

5、建立工单扫描件图片链接，分类着色

Sub 更新本地数据()   

'...... 

   Dim EndRow As Integer, Pic As String

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

   If EndRow > 1 Then

   Range("g2:g" & EndRow).Interior.ColorIndex = 2

   For i = 2 To EndRow

      Pic = "D:\kp\远程工单\" & Year(Date) & "-" & _

         Cells(i, 1) & ".jpg"

       ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 8), _

         Address:=Pic, TextToDisplay:=Pic

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

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

      Else

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

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

         Else                            '未完成未过期绿色

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

         End If

      End If

   Next i

   Range("e2:f" & EndRow).Interior.ColorIndex = 37 '标记可编辑区域

   End If

'......

End Sub

6、保护工作表

Sub 更新本地数据()   

'...... 

   Columns("i").EntireColumn.Hidden = True '隐藏i列（数据库索引）

   For i = 1 To Sheets(1).Protection.AllowEditRanges.Count

      Sheets(1).Protection.AllowEditRanges(1).Delete

   Next i

   If EndRow > 1 Then

   For i = 2 To EndRow

       Sheets(1).Protection.AllowEditRanges.Add Title:="区域" & _

          i - 1, Range:=Range("E" & i & ":F" & i)

   Next i

   End If

   Sheets(1).Protect ("111")   

   Application.ScreenUpdating = True

DNDST = 0  '撤除免打扰

End Sub

1、如图示插入一个命令按钮，在设计模式下双击按钮进入VBA窗口。

2、在属性窗口设置按钮属性，在代码窗体输入调用“更新本地数据”模块的代码：

Private Sub CommandButton1_Click()

   更新本地数据

End Sub

3、关闭设计模式激活按钮。

4、这是运行效果。

（待续。。。）

5、下期预告：

下期将设计执行客户端输出模块，敬请期待！