Question

我有一个与Worksheet_Change宏配合使用的工作表。

首先保护每个被修改的细胞，但只保护直接的相互作用。

可悲的是，最后两个代码在colums F：I中进行了更改，但它不是直接修改，第一个代码会保留那些不受保护的代码......

我需要保护这些列不受用户修改（但留给VBA更改）并让所有其他单元保护不受保护，直到用户修改它们为止。我已经尝试过UserInterfaceOnly：= True但似乎没有用。

所有细胞保持不受保护直到用户做出改变是至关重要的。只有列范围（“F：I”）应该是用户保护的，而不是VBA。

Application.EnableEvents = True
        ActiveSheet.Unprotect Password:="Athens"
        For Each cel In Target
            If cel.Value <> "" Then
                cel.Locked = True
                End If
        Next cel
        ActiveSheet.Protect Password:="Athens"

整个代码：

  Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rC As Range
    Dim P2 As Range
    Dim cel As Range


        Application.EnableEvents = True
        ActiveSheet.Unprotect Password:="Athens"
        For Each cel In Target
            If cel.Value <> "" Then
                cel.Locked = True
                End If
        Next cel
        ActiveSheet.Protect Password:="Athens"

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Application.EnableEvents = False
        For Each rC In Target.Cells
            Range("F" & rC.Row) = Now()
            Range("G" & rC.Row) = Environ("username")
        Next rC
        Application.EnableEvents = True
    ElseIf Not Intersect(Target, Range("C:C")) Is Nothing Then
        Application.EnableEvents = False
        For Each P2 In Target.Cells
            Range("H" & P2.Row) = Now()
            Range("I" & P2.Row) = Environ("username")
        Next P2
            Application.EnableEvents = True
    End If
End Sub

Answer 1

只需在公共模块代码表中运行一次。

sub specialProtect()
    worksheet("whatever").unProtect Password:="Athens"
    worksheet("whatever").Protect Password:="Athens",  UserInterfaceOnly:=True
end sub

现在，您可以从其余代码中删除所有.unprotect和.protect语句。用户无法更改您未允许的任何内容，您的VBA可以更改任何内容。

Answer 2

运行以下命令以启动表单保护。每次打开工作簿时都需要运行它

Public Sub InitiateSheetProtection()
    Dim strPassword As String
    strPassword = "Athens"

    With Sheets("YourSheetReferenceHere")
        .Unprotect Password:=strPassword
        .Cells.Locked = True
        On Error Resume Next
        .Range("Your User editable Range here").SpecialCells(xlCellTypeBlanks).Locked = False
        On Error GoTo 0
        .Protect Password:=strPassword, UserInterfaceOnly:=True
    End With
End Sub

然后在您的更改活动中使用以下

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target.Cells
        .Locked = True
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Locked = False
        On Error GoTo 0
    End With
End Sub

Worksheet_Change＆amp;范围用户单元保护

2 个答案: