excel 绘制对象时工作表不受保护：=false

9gm1akwq 于 2023-02-05 发布在其他

关注(0)|答案(3)|浏览(112)

在一个受保护的工作表上，我有一个验证列表，当一个区域中的值发生变化时，它会用VBA代码动态更新。通过worksheet_change事件调用此函数。首先我调用RemoveProtect，然后调用MakeValidateList，最后调用EnableProtect。

Public Sub RemoveProtect()

If ActiveSheet.ProtectContents = True Then
    Application.ScreenUpdating = False
    ActiveWorkbook.Unprotect
    ActiveSheet.Unprotect

    Application.ScreenUpdating = True
End If

End Sub

Public Function makeValidateList(ByVal cell As Range, ByVal r1 As Range) As Integer

Dim arrCargo() As String
Dim i, c As Integer

ReDim arrCargo(1)
arrCargo(0) = "SLOPS"   'vaste waarden
arrCargo(1) = "MT"
c = UBound(arrCargo) + 1

For i = 1 To r1.Count
    If r1.Cells(i, 1).Value <> "" Then
        ReDim Preserve arrCargo(UBound(arrCargo) + 1)
        arrCargo(c) = r1.Cells(i, 1).Value
        c = c + 1
    End If
Next i

With cell.Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=Join(arrCargo, ",")
    .IgnoreBlank = True
    .InCellDropdown = True
End With

End Function

Public Sub EnableProtect()

        If ActiveSheet.Protect = False Then
            Application.ScreenUpdating = False
            ActiveWorkbook.Protect
            ActiveSheet.Protect UserInterfaceOnly:=True, DrawingObjects:=False

            Application.ScreenUpdating = True
        End If

End Sub

使用drawingobjects：=false时，工作表不受保护，单元格不被锁定，公式不被隐藏。当删除drawingobjects：=false时，工作表受保护，公式被隐藏。但有效列表不更新。
我哪里做错了？

excel

来源：https://stackoverflow.com/questions/15712066/sheet-not-protected-when-drawingobjects-false

3条答案

按热度按时间

xiozqbni1#

请尝试以下代码：

Const strPassWord As String = "1234"

Public Function makeValidateList(ByVal cell As Range, ByVal r1 As Range) As Integer

    Dim arrCargo() As String
    Dim i, c As Integer

    ReDim arrCargo(1)
    arrCargo(0) = "SLOPS"   'vaste waarden
    arrCargo(1) = "MT"
    c = UBound(arrCargo) + 1

    For i = 1 To r1.Count
        If r1.Cells(i, 1).Value <> "" Then
            ReDim Preserve arrCargo(UBound(arrCargo) + 1)
            arrCargo(c) = r1.Cells(i, 1).Value
            c = c + 1
        End If
    Next i

    With cell.Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=Join(arrCargo, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
    End With

End Function

 Sub EnableProtect()
'Assumed Sheets("Sheet1") change it if needed
    Sheets("sheet1").Range("B1:B100").Locked = False ' You can alter this range as per your requirement
    Sheets("sheet1").Protect Password:=strPassWord, DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 Sub RemoveProtect()
    Sheets("sheet1").Unprotect Password:=strPassWord
End Sub

赞(0）回复(0）举报 2023-02-05

mfpqipee2#

用DrawingObjects:=0代替DrawingObjects:=false为我工作。

赞(0）回复(0）举报 2023-02-05

cyej8jka3#

设置