Colorful Life²⁰¹⁰

由于Tracy要求财务上用的EXCEL表要实现的功能：当前SHEET页上的某些单元格或行或列，录入数据的人，只有录入一次，录入完则立即保护起来，如果想修改，只能有密码的人才能修改。

从这可以衍生出更具体的要求：

1. 输入一次即保护起来，想再修改必须输入密码（即原始要求）
2. 未输入的空白区（保护作用区，即将会被保护的）可以随便操作
3. 输入密码后，只能修改当前选中的单元格，不能随意修改其它被保护的单元格
4. 要修改被保护的单元格，弹出输入密码框
5. 输入密码验证后，拉选（多选）单元格区域，被保护的还是不能被删除
6. 被保护起来的单元格要特殊显示
7. 保护状态下，拉选（多选）时不会触发密码提示框

这个功能对于财务上的数据采集比较有用，并且能有效抑制数据出错的频率及监督工作质量（^_^)。实现起来也比较容易，但是对于VBA，有个比较麻烦的情况是，如果要运行 VBA，那么EXCEL的安全级别不能太高只能设置为中低，设置为中高及以上VBA直接就被禁用了。另外，需要对VBAProject设置密码，要不使用者一改VBA，这个功能就形同虚设了。

下面是代码：

'//Customize the specified cell/row/column/range to editable once time.
'//To enable the VBA script,reset the security to middle-lower.
'//No Copyright,shared,come from http://3rgb.com 20090408

Const pwd As String = "viking"  'define the worksheet protect password
Const lckType As Integer = 3    'define lock type(1:cell/2:row/3:column/4:range)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim isTarget: isTarget = False
Application.EnableEvents = False
If Target.Count = 1 Then
    Select Case lckType
    Case 1
        'example for cell
        Select Case Target.Address
        Case "$A$2", "$B$2", "$C$2"
            isTarget = True
        Case Else
        End Select
    Case 2
        'example for rows
        R = Target.Row
        Select Case R
        Case 1, 2, 3, 4, 5, 6, 7, 8
            isTarget = True
        Case Else
        End Select
    Case 3
        'example for column
        C = Target.Column
        Select Case C
        Case 4, 5, 6, 7
            isTarget = True
        Case Else
        End Select
    Case 4
        'example for cells range
        'from cell(lrs,lcs) to cell(lre,lce)
        lrs = 4 'start row
        lre = 8 'end row
        lcs = 2 'start column
        lce = 5 'end column
        If Target.Row >= lrs And Target.Row <= lre And Target.Column >= lcs And Target.Column <= lce Then
            isTarget = True
        End If
    End Select
    'if is target, lock & protect it
    If isTarget Then
        Me.Unprotect (pwd)
        Target.Locked = True            'lock the cell
        Target.FormulaHidden = True     'hide the formula
        Target.Interior.ColorIndex = 6  'set back color
        'Target.Borders.Weight = 1       'set cell border
        Me.Protect (pwd)
    End If
Else
    Me.Protect (pwd)
End If
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'if have text and locked
If Target.Text <> "" Then
    If Target.Locked = True Then
        'UserForm1.Show
        Me.Unprotect
    End If
Else
    If Target.Count = 1 Then
        Me.Unprotect (pwd)
        Target.Locked = False           'Unlock the cell
        Target.FormulaHidden = False    'show the formula
        Target.Interior.ColorIndex = 0  'clear the back color
        'Target.Borders.Weight = 2
        Me.Protect (pwd)
    End If
End If
End Sub