Можно ли добавить листобъект в vba на защищенном листе? или мне сначала нужно разблокировать лист. добавить списки объектов. снова заблокируйте лист,
, потому что добавление текста и цветов работает
код, который я использую для блокировки листов:
Dim WSheet As Worksheet
Sub ProtectSheets()
For Each WSheet In Worksheets
WSheet.Protect Password:="Password!", _
UserInterfaceOnly:=True
Next WSheet
End Sub
код Я получаю сообщение об ошибке:
'Module voor Blad1(Ruimtelijst)
Option Explicit
Dim Index1 As Range
Dim Index2 As Range
Dim Tbl As Object
Dim ws As Worksheet
Dim Col As Long
Dim IngevuldeCellen As Long
Dim I As Long
Dim OldColumnWidth As Long
Dim NewColumnWidth As Long
'Standaard template voor Tabel
Sub Opmaak(Sht As String, Start As Variant, Einde As Variant, Titel As String, HeaderLength As Long, SubTitel() As String)
With Worksheets(Sht)
'Omtrek van de sheet maken
.Range(Start & ":" & Einde.Address).Interior.Color = RGB(59, 148, 0)
'Titel schrijven + opmaak
Set Index1 = .Range(Start).Offset(1, 1)
Set Index2 = .Range(Einde.Address).Offset(-2, -1)
.Range(Index1.Address & ":" & Index2.Address).Interior.Color = RGB(62, 199, 98)
.Range(Index1.Address & ":" & Index2.Address).HorizontalAlignment = xlCenter
.Range(Index1.Address & ":" & Index2.Address).Font.Bold = True
Set Index2 = .Range(Index1.Address).Offset(0, HeaderLength)
.Range(Index1.Address).Value = Titel
.Range(Index1.Address & ":" & Index2.Address).Merge
.Range(Index1.Address & ":" & Index2.Address).Borders(xlBottom).LineStyle = xlContinuous
'Subtitel schrijven + opmaak
Set Index1 = .Range(Index1.Address).Offset(1, 0)
Set Index2 = .Range(Index2.Address).Offset(1, 0)
Ошибка, которую я получаю, начинается здесь и является ошибкой 3000: Табличные функции недоступны, потому что этот лист заблокирован (он на голландском языке, так что подберите точные слова)
Set Tbl = .ListObjects.Add(xlSrcRange, Source:=.Range(Index1.Address & ":" & Index2.Address), XlListObjectHasHeaders:=xlYes)
Tbl.Name = Titel & "Tabel"
For I = 0 To HeaderLength
.Range(Index1.Address).Offset(0, I).Value = SubTitel(I)
.Range(Index1.Address).Offset(0, I).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range(Index1.Address).Offset(0, I).Borders(xlEdgeRight).LineStyle = xlContinuous
.Range(Index1.Address).Offset(1, I).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range(Index1.Address).Offset(1, I).Borders(xlEdgeRight).LineStyle = xlContinuous
Next I
Set Index1 = .Range(Index1.Address).Offset(1, 0)
Set Index2 = .Range(Index2.Address).Offset(1, 0)
.Range(Index1.Address & ":" & Index2.Address).Interior.Color = RGB(151, 245, 137)
Set Index1 = .Range(Index1.Address).Offset(-1, 0)
Set Index2 = .Range(Index2.Address).Offset(-1, 0)
.Range(Index1.Address & ":" & Index2.Address).Columns.AutoFit
'Nummer en Naam toevoegen aan tabel
If Tbl.Range(2, 1).Value = "" Then
Tbl.Range(2, 1).Value = "1"
End If
If Tbl.Range(2, 2).Value = "" Then
Tbl.Range(2, 2).Value = "Ruimte 1"
End If
End With
Set ws = ThisWorkbook.Worksheets("Dropdown")
Set Index1 = ws.Range("E3:E14")
With Tbl.Range(2, 3).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & ws.Name & "'!" & Index1.Address
End With
Set Index1 = ws.Range("F3:F8")
With Tbl.Range(2, 4).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Formula1:="='" & ws.Name & "'!" & Index1.Address
End With
End Sub
, поэтому всякий раз, когда я пытаюсь чтобы добавить список объектов, я получаю сообщение об ошибке.
Чтобы проверить, возможно ли, что я применил защиту неправильно, я сначала изменил sub protectSheets () (Первый код) на
Dim WSheet As Worksheet
Sub ProtectSheets()
For Each WSheet In Worksheets
WSheet.unrotect Password:="Password!"
Next WSheet
End Sub
И после этого я вернул его обратно, чтобы снова заблокировать.