保护非空单元VBA [英] Protect non-empty cells VBA

问题描述

我添加了VBA代码，该代码可在双击时将时间或日期插入到单元格中.我设法使它进展顺利.

I've added VBA code which will insert either the time or date to a cell upon double clicking. I managed to get that going pretty well.

输入时间/日期后，我苦苦挣扎的一点是让该单元进行保护和锁定.

The bit I'm struggling with is getting the cell to protect and lock after the time/date has been entered.

我已经达到了当我双击/尝试编辑非空单元格时出现运行时错误的地步.调试后，引发我的行是"Target.Formula = Format(Now, "ttttt")".

I've got to a point where when I double click/try to edit a non-empty cell, I get a runtime error. Upon debugging, the line that throws me up is "Target.Formula = Format(Now, "ttttt")".

我也无法抛出错误消息.

I'm also not able to throw an error message either.

我好亲近！

任何建议将不胜感激！

我的代码:

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

推荐答案

发生错误的原因是工作表被锁定，直到工作表上发生某些更改为止，因此，如果删除Worksheet_Change事件并将代码作为遵循，那么它应该工作:

The reason for your error is that the sheet is locked until some change happens on the worksheet, so if you remove the Worksheet_Change event and have your code as follows then it should work:

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的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！