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.
精彩评论