Question

我正在学习Excel VBA，对不起，我的英语不好

在保护工作表时，我正在努力运行VBA代码以将数据添加到每个工作表中每个表的最后一行中。

我在ThisWorkbook中有此代码来保护工作表

Private Sub Workbook_Open()
    Dim wSheet As Worksheet
    For Each wSheet In Worksheets
        wSheet.Protect Password:="Secret", _
        UserInterFaceOnly:=True
    Next wSheet
End Sub

和以下代码添加数据，但会抛出

错误1004“应用程序定义的错误或对象定义的错误”

在工作表受保护时，在Set newrow1 = tbl.ListRows.Add上

。

Sub AddDataToTable()
    Application.ScreenUpdating = False
    Dim MyValue As String
    Dim sh As Worksheet
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet
    Dim ws4 As Worksheet
    Dim ws5 As Worksheet
    Set ws1 = Sheets("Setting")
    Set ws2 = Sheets("R_Buy")
    Set ws3 = Sheets("R_Sell")
    Set ws4 = Sheets("S_Buy")
    Set ws5 = Sheets("S_Sell")
    Dim tbl As ListObject
    Dim tb2 As ListObject
    Dim tb3 As ListObject
    Dim tb4 As ListObject
    Dim tb5 As ListObject
    Set tbl = ws1.ListObjects("T_Setting")
    Set tb2 = ws2.ListObjects("T_R_Buy")
    Set tb3 = ws3.ListObjects("T_R_Sell")
    Set tb4 = ws4.ListObjects("T_S_Buy")
    Set tb5 = ws5.ListObjects("T_S_Sell")
    Dim newrow1 As ListRow
    Dim newrow2 As ListRow
    Dim newrow3 As ListRow
    Dim newrow4 As ListRow
    Dim newrow5 As ListRow

    MyValue = InputBox("Add To Table, this cannot be undone")

    'check if user clicked Cancel button and, if appropriate, execute statements
    If StrPtr(MyValue) = 0 Then
        'display message box confirming that user clicked Cancel button
        MsgBox "You clicked the Cancel button"
        'check if user entered no input and, if appropriate, execute statements
    ElseIf MyValue = "" Then
        'display message box confirming that user entered no input
        MsgBox "There is no Text Input"
    Else
        Set newrow1 = tbl.ListRows.Add
        With newrow1
            .Range(1) = MyValue
        End With

        Set newrow2 = tb2.ListRows.Add
        With newrow2
            .Range(1) = MyValue
        End With

        Set newrow3 = tb3.ListRows.Add
        With newrow3
            .Range(1) = MyValue
        End With

        Set newrow4 = tb4.ListRows.Add
        With newrow4
            .Range(1) = MyValue
        End With

        Set newrow5 = tb5.ListRows.Add
        With newrow5
            .Range(1) = MyValue
        End With
    End If
    Application.ScreenUpdating = True
End Sub

有人可以帮我这个忙吗，或者有其他方法可以添加数据

Answer 1

这是Excel的问题，它不允许在UserInterFaceOnly:=True模式下编辑表。不幸的是，我发现的唯一解决方法是在应用任何表方法之前先取消保护，然后再执行以下操作：

.Unprotect Password:=SHEET_PW 'unprotect sheet          
'edit table         
.Protect Password:=SHEET_PW, UserInterFaceOnly:=True 'reprotect

另外，我建议进行以下改进以缩短您的代码：

使用数组Dim tbl(1 To 5)而不是多个变量tbl1, tbl2, tbl3, …
或者最好使用数组仅列出您的工作表名称。
使用更多描述性的变量名（使您的生活更易于维护和阅读代码）
如果表名始终为 T_，后接工作表名称，则可以轻松地从工作表名称中生成表。
为工作表密码SHEET_PW使用一个常数，以将其仅存储在一个位置（便于更改，防止输入错误）。
使用循环来做重复的事情。

所以我们最终得到：

Option Explicit

Const SHEET_PW As String = "Secret" 'global password for protecting worksheets

Public Sub AddDataToTableImproved()
    Dim AddValue As String
    AddValue = InputBox("Add To Table, this cannot be undone")

    If StrPtr(AddValue) = 0 Then 'cancel button
        MsgBox "You clicked the Cancel button"
        Exit Sub
    ElseIf AddValue = "" Then 'no input
        MsgBox "There is no Text Input"
        Exit Sub
    End If

    Dim NewRow As ListRow

    Dim SheetNameList() As Variant
    SheetNameList = Array("Setting", "R_Buy", "R_Sell", "S_Buy", "S_Sell")

    Dim SheetName As Variant
    For Each SheetName In SheetNameList
        With ThisWorkbook.Worksheets(SheetName)
            .Unprotect Password:=SHEET_PW 'unprotect sheet

            Set NewRow = .ListObjects("T_" & SheetName).ListRows.Add
            NewRow.Range(1) = AddValue

            .Protect Password:=SHEET_PW, UserInterFaceOnly:=True 'reprotect it
        End With
    Next SheetName
End Sub

将ListRow添加到受保护的工作表的表（UserInterFaceOnly：= True）失败

1 个答案: