How to disable changes in a cell using vba?

2020-08-17 18:12发布

问题:

I am working with the bellow code: This code do for Example: If I input any value in cell A1, cell B1 display a time stamp.

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Target
       If .Count > 1 Then Exit Sub
       If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
           Application.EnableEvents = False
           If IsEmpty(.Value) Then
               .Offset(0, 1).ClearContents
           Else
               With .Offset(0, 1)
                   .NumberFormat = "hh:mm AM/PM"
                   .Value = Now
               End With
           End If
           Application.EnableEvents = True
       End If
    End With
    End Sub

What I am trying to do now is to protect/not editable from the user the cell "B1:B10" once time stamp has made by the macro. I google on how to protect but I am having hard time to insert those code I found. Can anyone help me how I construct/insert this code to my original code?

    Private Sub Worksheet_Change(ByVal Target As Range)
    'set your criteria here
    If Target.Column = 1 Then

        'must disable events if you change the sheet as it will
        'continually trigger the change event
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True

        MsgBox "You cannot do that!"
    End If
    End Sub

Or this code:

    'select the cell you want to be editable
    Worksheets("Sheet1").Range("B2:C3").Locked = False
    'then protect the entire sheet but still vba program can modify instead.
    Worksheets("Sheet1").Protect UserInterfaceOnly:=True

Thanks to Kazjaw. Here is the final code.

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    'Protect cell "B1:B10"
    Worksheets("Sheet1").Cells.Locked = False
    Worksheets("Sheet1").Range("B1:b10").Locked = True
    Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=Tru

    With Target
       If .Count > 1 Then Exit Sub
       If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
           Application.EnableEvents = False
           If IsEmpty(.Value) Then
               .Offset(0, 1).ClearContents
           Else
               With .Offset(0, 1)
                   .NumberFormat = "hh:mm AM/PM"
                   .Value = Now
               End With
           End If
           Application.EnableEvents = True
       End If
    End With
    End Sub

回答1:

If you want to protect only Range B1:B10 then you need to run this sub only once:

Sub ProtectCellsInB()

    Worksheets("Sheet1").Cells.Locked = False
    Worksheets("Sheet1").Range("B1:b10").Locked = True
    Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=True

End Sub

I made a modification- I added a password to protection which you can delete.

If you are not sure how to run it once then you could add the whole internal code at the end of your Private Sub Worksheet_Change(ByVal Target As Excel.Range)



标签: vba excel