保护非空单元格 VBA

Question

我添加了 VBA 代码，可以在双击时将时间或日期插入单元格。我设法让它进展顺利。

我正在努力解决的问题是在输入 time/date 后保护和锁定单元格。

我已经到了这样的地步，当我加倍 click/try 来编辑非空单元格时，出现运行时错误。调试后，让我失望的是 "Target.Formula = Format(Now, "ttttt")".

我也无法抛出错误消息。

我很接近！

如有任何建议，我们将不胜感激！

我的代码：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


    If Not Intersect(Target, Range("C:E")) Is Nothing Then
        Cancel = True
        Target.Formula = Format(Now, "ttttt")
      End If

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Cancel = True
        Target.Formula = Format(Now, "dd/mm/yyyy")

      End If


End Sub


Private Sub Worksheet_Change(ByVal Target As Range)

   On Error GoTo ErrorHandler

    Dim xRg As Range
    Set xRg = Intersect(Range("A:A,C:E"), Target)
    If xRg Is Nothing Then Exit Sub
    Target.Worksheet.Unprotect Password:="123"
    xRg.Locked = True
    Target.Worksheet.Protect Password:="123"

   Exit Sub
ErrorHandler:
   MsgBox "Cell already filled"

   Resume Next


End Sub

Answer 1

你的错误的原因是 sheet 被锁定，直到工作发生一些变化 sheet，所以如果你删除 Worksheet_Change 事件并让你的代码如下那么它应该可以工作：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Target.Worksheet.Unprotect Password:="123"
    If Not Intersect(Target, Range("C:E")) Is Nothing Then
        If Target.Value = "" Then
            Cancel = True
            Target.Formula = Format(Now(), "ttttt")
        End If
      End If

    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        If Target.Value = "" Then
            Cancel = True
            Target.Formula = Format(Now, "dd/mm/yyyy")
        End If
    End If
Target.Worksheet.Protect Password:="123"
End Sub

Answer 2

Protect your worksheet 一次使用 UserInterfaceOnly:=True 参数，您将不必 unprotect/protect 使用 VBA.

更改单元格内容

sub protectOnce()
    worksheets("sheet1").unprotect password:="123"
    worksheets("sheet1").protect password:="123", UserInterfaceOnly:=True
end sub

保护非空单元格 VBA

Protect non-empty cells VBA

error-handling

excel

vba

error-messaging