Защищайте непустые клетки VBA

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

Причиной вашей ошибки является то, что лист заблокирован, пока на листе не произойдут какие-либо изменения, поэтому, если вы удалите 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

Защитите свой рабочий лист один раз с помощью параметра UserInterfaceOnly:=True, и вам не придется снимать защиту / защиту, чтобы изменить содержимое ячейки с помощью VBA.

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