锁定某个范围内的某些单元格

Question

I'm trying to loop through a range of cells, locking any cell that has content while leaving empty cells unlocked.

When I run the below code the result is the entire sheet is locked. If I add an else statement the sheet is unlocked. Basically whatever the last .locked = (true, false) statement is is how the entire sheet winds up.

Change 1 Is it possible that I have some setting on/off that is interfering since I'm the only one who is unable to get any of this to work?

Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range

'Clear the default status
ActiveSheet.Unprotect
Range("A7:I35").Locked = False

Set chRng = ActiveSheet.Range("A7:I35")

'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
    If chCell.Value <> "" Then Cells.Locked = True
Next chCell

ActiveSheet.Protect

End Sub

Answer 1

Sub ProtectTheSheet()
    Dim chCell As Range
    Dim chRng As Range

    ActiveSheet.Unprotect
    Set chRng = ActiveSheet.Range("A7:I35")

    'Check cell value in body and lock cells with content
    For Each chCell In chRng.Cells
        chCell.Locked = (chCell.Value <> "")
    Next chCell

    ActiveSheet.Protect

End Sub

Answer 2

Check this out: http://www.mrexcel.com/archive/VBA/15950b.html

Sub CellLocker()
Cells.Select
' unlock all the cells
Selection.Locked = false
' next, select the cells (or range) that you want to make read only, 
' here I used simply A1
Range("A1").Select
' lock those cells
Selection.Locked = true
' now we need to protect the sheet to restrict access to the cells. 
' I protected only the contents you can add whatever you want
ActiveSheet.Protect DrawingObjects:=false, Contents:=true, Scenarios:=false
End Sub

If you say Range("A1").Select, then it locks only A1. You can specify multiple cells to be locked by specifying as follows:
A3:A12,D3:E12,J1:R13,W18
This locks A3 to A12 and D3 to E12 etc.

Answer 3

I know this is an old thread, but I've been stuck on this for a while too, and after some testing on Excel 2013 here's what I conclude if your range includes any merged cell

• The merged cells must be entirely included within that range (eg the merging must be entirely within the range being lock/unlocked
• The range being merged can be larger, or at least exactly the range corresponding to the merged cells. If it's a named range that works as well.

Also, you cannot lock/unlock a cell that is already within a protected range. Eg if you run:

public sub test()
   Sheet1.range("myNameRange").locked = true
   Sheet1.protect
end sub

Twice it will work the first time, and fail the second time around. So you should unprotect the target range (or the sheet) before....

Answer 4

You can try this.

Public Sub abc()
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Range("I8:I500, K8:K500, M8:M500, N8:N500").Cells.Locked = False
ActiveSheet.Protect Password:="1234"
End Sub

Answer 5

If you want to protect the specific cells of any specific excel without the password protection then here is the solution:

Sub ProtectingSheet()

  Workbooks.Open (c\documents\....)

  Dim mainworkBook As Workbook

  Set mainworkBook = ActiveWorkbook

  Worksheets(CellValue).Activate

  mainworkBook.Sheets("Sheet1").Range("A1:AA100").Locked = True

  Range(Cells(1, 2), Cells(1, 25)).Select
  Selection.Locked = False

  ActiveSheet.Protect

End Sub

Answer 6

I may be missing something but...

Cells.Locked = True

...will lock all cells on the active sheet. If you just change it to...

chCell.Locked = True

...then it works; I think?! As the range is very small, you may as well not unlock cells at the start, and instead unlock cells whilst locking them eg

For Each chCell In chRng.Cells
    If chCell.Value <> "" Then 
    chCell.Locked = True
    Else
    chCell.Locked = False
    End If
Next chCell

If you are new to VBA, I would recommend cycling through code line-by-line as described in this Excel consultant's video . If you step through code, you can check "has cell A7 behaved as expected?"...instead of just seeing the end product

Answer 7

A quick way to unlock non-blank cells is to use SpecialCells see below.

On my testing this code handles merged cells ok , I think this is what is generating your error on Tim's code when it looks to handle each cell individually (which to be clear is not an issue in Tim's code, it is dealing with an unexpected outcome)

You may also find this article of mine A fast method for determining the unlocked cell range useful

Sub Quicktest()
    Dim rng1 As Range
    Dim rng2 As Range
    On Error Resume Next
    Set rng1 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlFormulas)
    Set rng2 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlConstants)
    On Error GoTo 0
    ActiveSheet.Unprotect
    ActiveSheet.Range("A7:I35").Cells.Locked = False
    If Not rng1 Is Nothing Then rng1.Cells.Locked = True
    If Not rng2 Is Nothing Then rng2.Cells.Locked = True
    ActiveSheet.Protect
End Sub