【问题标题】:Sheet not protected when drawingobjects:=false绘图对象时工作表不受保护:= false
【发布时间】:2013-03-29 21:59:14
【问题描述】:

在受保护的工作表上,我有一个验证列表,当某个范围内的值发生更改时,该验证列表会使用 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 excel-2007 vba


    【解决方案1】:

    试试下面的代码:

    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
    

    【讨论】:

      【解决方案2】:

      使用 DrawingObjects:=0 而不是 DrawingObjects:=false 为我工作。

      【讨论】:

        猜你喜欢
        • 2020-10-07
        • 2018-03-11
        • 2021-11-17
        • 1970-01-01
        • 1970-01-01
        • 2015-05-16
        • 1970-01-01
        • 2016-11-24
        • 2022-01-23
        相关资源
        最近更新 更多