开发者

Excel vba: restrict edit area in excel sheet

I want to restrict the users to edit range in Ms Excel sheet.

Scenario:

  | A | B | C | D | E | F | G | H | I | J | ... IV
-------------------------------------------
1 |   |   |   |   |   |   |   |   |   |   |
-------------------开发者_如何学Go------------------------
2 |   |   |   |   |   |   |   |   |   |   |
-------------------------------------------
3 |   |   |   |   |   |   |   |   |   |   |
-------------------------------------------
4 |   |   |   |   |   |   |   |   |   |   |
-------------------------------------------
...
65536

In the above spreadsheet user should have access to edit the range Column A to Column H. Column I to IV users should not allow to edit any text or anything. No restriction on number of rows.

Thanks :)


To do this programatically, try this in a module (and adapt it to suit your needs):

Sub ProtectAToH()
Dim ws as Worksheet
For each ws In ActiveWorkbook.Worksheets
  ws.Columns("A:H").Locked = False
  ws.Protect Contents:=True, Password:="myPassword"
Next ws
End Sub


In three steps

1) Select the whole sheet. Format->Lock Cells->Remove locking for all cells. (All cells are initially "locked" by default)

2) Select your desired locking columns. Format->Lock Cells->Apply Locking (This is declarative, you are not locking nothing, just declaring what you will lock in the next step)

3) Format-> Protect Worksheet. (This trigger the real protection)

You are done.

HTH


Some alternatives to sasfrog and belisarius proposals (just to enrich your options):

a) you may also just HIDE columns K:IV, and protect the worksheet to prevent unhiding
b) Using the Tools, Protection, "Allow users to edit ranges" option, define range $a:$h as editable without password for users belonging to Everyone group, then protect your sheet. I like that one.

Don't forget that any solution involving Excel built in protection will prevent your users from inserting/deleting rows.

c) Using VBA (would not prevent deleting/inserting rows):

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not (Intersect(Target, Range("$h:$iv")) Is Nothing) Then
    Target.Value = ""  'or something else'
  End If
End Sub


ActiveSheet.ScrollArea = "$A:$H"

will restrict what cells the user can select.


iDevlop's option c) should be modified to prevent an infinite loop:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Not Intersect(Target, Target.Worksheet.Range("A1:G25")) Is Nothing Then
        If Not Target.Cells.Count > 1 Then                  'Prevent Error on Row Insert or Delete
            If Not Target.Value = "" Then Target.Value = "" 'Prevent infinite loop
        End If
    End If
End Sub

This will still allow a user to make a multi-cell copy paste into your specified Intersect range. Havent figured that one out.

0

上一篇:

下一篇:

精彩评论

暂无评论...
验证码 换一张
取 消

最新问答

问答排行榜