Question

我已经添加了VBA代码，它会在双击时向单元格插入时间或日期。我设法做得很好。

我努力争取的一点就是在输入时间/日期后让细胞保护并锁定。

当我双击/尝试编辑非空单元格时，我得到了运行时错误。在调试时，抛出我的行是"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

Protect your worksheet一次使用UserInterfaceOnly：= True参数，您不必取消保护/保护以使用VBA更改单元格内容。

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

Answer 2

出现错误的原因是工作表上的某些更改发生之前工作表已被锁定，因此，如果您删除了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

保护非空单元VBA

2 个答案: