Защита листов userinterfaceonly не разрешает списки объектов? - PullRequest
0 голосов
/ 21 апреля 2020

Можно ли добавить листобъект в 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

И после этого я вернул его обратно, чтобы снова заблокировать.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...