77家的会客2010

用VBA实现EXCEL单元格输入即保护功能
Weather:春天来了,百花还未花

由于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

[用VBA实现EXCEL单元格输入即保护功能]的回复

TRACY 于 2009-04-08 13:50:19 发表 | IP:119.113.165.*
有人叫我姐姐...让我教他...
我说 我也比较晕...

TRACY 于 2009-04-08 13:50:39 发表 | IP:119.113.165.*
我真的晕...
TRACY 于 2009-04-08 13:51:49 发表 | IP:119.113.165.*
不过现在好了. 哈哈....

小朋友里全是你和RE的头像...
4#   柠檬园主 于 2009-04-09 20:23:49 发表 | IP:119.109.24.*
继续继续,还有啥?
EXCEL太博大精深了。要什么功能还真得好好研究研究

5#   re 于 2009-04-10 01:07:42 发表 | IP:114.93.108.*
谁是Tracy?
6#   柠檬园主 于 2009-04-10 01:27:37 发表 | IP:119.109.24.*
喃嫂子~~
Post a Comment~