如何动态锁定和解锁 Excel 中的单元格？

Question

What should i do to dynamically lock/unlock my cell in excel? For example, if i create a new document, by default all cells are unlock but i entered a data on that cell it will be lock. I tried this, which i found here Lock empty cells and unlock free cells

Sub test()
    Dim rngTemp As Range

    For Each rngTemp In Range("A1:XFD1048576").Cells
        With rngTemp
            If .Value > 0 Or Len(.Value) > 0 Then
                .Locked = False
            End If
        End With
    Next
End Sub

but it's not working on my case. I am using 2007 excel version. Do i still need to save the code or Alt + Q is enough?

---

EDIT: As per @JvdV's answer I tried the following:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
With Sheet1
    .Unprotect
    .Cells.Locked = True
    .Cells.SpecialCells(xlCellTypeBlanks).Locked = False
    .Protect
End With
End Sub

But this returns an error Run-time error '1004' No cells were found on .Cells.SpecialCells(xlCellTypeBlanks).Locked = False .

Answer 1

If you really are intested in those cells, you can simply refer to a worksheet's cells. Also, no need to loop through those cells individually, for example:

Sub test()

Dim rng As Range
With Sheet1 'Change according to your sheet's CodeName
    .Unprotect
    .Cells.Locked = False
    .Cells.SpecialCells(xlCellTypeBlanks).Locked = True
    .Protect
End With

End Sub

Where .Cells.Locked = False unlocks all cells and .Cells.SpecialCells(xlCellTypeBlanks).Locked = True locks all cells blank cells _{(Note: a ="" value through formulas is considered a value and will stay unlocked)}

Both Unprotect and Protect are needed to have full effect of your changes.

If this is code you want to run each time a value is changed, you'll have to look into the Worksheet_Change event. And if your goal is to have empty cells unlocked and cells that contain a value locked, just swap around the True and False .

---

EDIT (as per your comments)

If this is something you like to run on every next selection of cells, try the following (error handler included since you not using the whole worksheet nomore)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Sheet1.Unprotect 'Change according to your sheet's CodeName
With Target
    .Cells.Locked = True
    On Error Resume Next
    .Cells.SpecialCells(xlCellTypeBlanks).Locked = False
    On Error GoTo 0
End With
Sheet1.Protect

End Sub

If you looking for an alternative where you loop through your target range, you can implement the suggestion by @M.Schalk

Answer 2

As an addition to the (correct) answer above, here is my suggestion for a Worksheet_Change event, as you requested in the comments. This will have to be placed in the workbook-specific code module:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cll As Range
On Error Resume Next

For Each cll In Target.Cells
    With cll
        If .Value2 <> vbNullString Then
            .Locked = True
        Else
            .Locked = False
        End If
    End With
Next
End Sub

It's important to note, that (at least in my version of Excel) the .Locked property of a cell only has an effect when the sheet is protected. To change the value of the .Locked property however, the sheet must not be protected. To incorporate this you might want to use something like this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cll As Range
On Error GoTo Handler

Me.Unprotect
For Each cll In Target.Cells
    With cll
        If .Value2 <> vbNullString Then
            MsgBox cll.Value2
            .Locked = True
        Else
            MsgBox "NullString"
            .Locked = False
        End If
    End With
Next
Handler:
    Me.Protect
End Sub

This will lead to every cell becoming un-changeable once a value is entered, while still letting the user enter values in all empty cells. To change existing values you will need to manually unprotect the sheet. You might use something like the code provided in the answer above to restore a desired state after the sheet was unprotected and changed.