Лист, не защищенный при рисовании объектов: = false

Question

На защищенном листе У меня есть список проверки, который динамически обновляется кодом VBA при изменении значений в диапазоне. С событием workheet_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 

С чертежными объектами: = false лист остается незащищенным, ячейки не заблокированы, а формулы не скрыты. Когда drawobjects: = false удаляется, лист защищен и формулы скрыты. Но validatelist не обновляется.

Что я делаю неправильно?

Answer 1

Try ниже код:

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 

Answer 2

Использование DrawingObjects:=0 вместо DrawingObjects:=false работы для меня.