第二次运行 vba 代码时出现运行时 1004 错误

Question

我编写了一个小模块来保护我工作簿的所有工作表并保护某些工作表中的某些范围。

代码第一次运行顺利，但尝试第二次运行时出现运行时 1004 错误“应用程序定义或对象定义错误”

我想我可能在以下页面上找到了一些解释： http://support.microsoft.com/kb/178510 但我就是想不通..

有人可以帮我吗？

我的代码如下。

根据首先保护的工作表，可能是这一行

WS.Protection.AllowEditRanges.Add Title:=titlef _
        , Range:=WS.Range("L:R"), Password:="pw2"

或以下引发错误的行

WS.Protection.AllowEditRanges.Add Title:=titlec _
        , Range:=WS.Range("N:T"), Password:="pw3"

Sub Protect()
Dim WS As Worksheet
Dim pWord As String
pWord = "pw1"

Dim aer As AllowEditRange
For Each WS In Worksheets
    WS.Unprotect pWord
For Each aer In WS.Protection.AllowEditRanges
    aer.Delete
Next aer
Next WS

Dim counterf As Integer
Dim counterc As Integer
counterf = 1
counterc = 1
Dim titlef As String
Dim titlec As String

For Each WS In ActiveWorkbook.Worksheets
    WS.Protect Password:=pWord, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    WS.EnableSelection = xlNoRestrictions
    If InStr(UCase(WS.Name), "FORM") Then
        titlef = "Volumes form faits par poste" & counterf
        WS.Unprotect pWord
        WS.Protection.AllowEditRanges.Add Title:=titlef _
        , Range:=WS.Range("L:R"), Password:="pw2"
        WS.Protect pWord
        counterf = counterf + 1
    ElseIf InStr(UCase(WS.Name), "COND") Then
        titlec = "Volumes cond faits par poste" & counterc
        WS.Unprotect pWord
        WS.Protection.AllowEditRanges.Add Title:=titlec _
        , Range:=WS.Range("N:T"), Password:="pw3"
        WS.Protect pWord
        counterc = counterc + 1
    End If
Next

End Sub

Answer 1

根据您发布的知识库文章，我认为问题出在Worksheets 和/或ActiveWorkbook。由于您没有专门实例化这些对象，因此 Excel 为您提供了一个副本，基本上是在填补空白。然而，这个副本仍然存在。下面的代码在顶部创建了两个变量，并在底部杀死了这些变量。然后，它不使用Worksheets，而是使用xlBook.Worksheets，而不是ActiveWorkbook.Worksheets，它使用xlApp.ActiveWorkbook.Worksheets。

Sub Protect()
    'Create an actual instance of the Excel Application and Workbook
    Dim xlApp As Excel.Application 
    Dim xlBook As Excel.Workbook

    Dim WS As Worksheet
    Dim pWord As String
    pWord = "pw1"

    Dim aer As AllowEditRange
    'Use the object's Worksheets instead of the automatic variable
    For Each WS In xlBook.Worksheets
        WS.Unprotect pWord
        For Each aer In WS.Protection.AllowEditRanges
            aer.Delete
        Next aer
    Next WS

    Dim counterf As Integer
    Dim counterc As Integer
    counterf = 1
    counterc = 1
    Dim titlef As String
    Dim titlec As String

    'Once again, use the application's property
    For Each WS In xlApp.ActiveWorkbook.Worksheets
        WS.Protect Password:=pWord, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
        WS.EnableSelection = xlNoRestrictions
        If InStr(UCase(WS.Name), "FORM") Then
            titlef = "Volumes form faits par poste" & counterf
            WS.Unprotect pWord
            WS.Protection.AllowEditRanges.Add Title:=titlef _
            , Range:=WS.Range("L:R"), Password:="pw2"
            WS.Protect pWord
            counterf = counterf + 1
        ElseIf InStr(UCase(WS.Name), "COND") Then
            titlec = "Volumes cond faits par poste" & counterc
            WS.Unprotect pWord
            WS.Protection.AllowEditRanges.Add Title:=titlec _
            , Range:=WS.Range("N:T"), Password:="pw3"
            WS.Protect pWord
            counterc = counterc + 1
        End If
    Next

    'Clean up
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub

Answer 2

老问题，但我在代码中遇到了类似的问题，在我看来，为了让 AlloEditRange.Delete 函数工作，工作表本身必须处于活动状态。因此，我相信您删除所有 AllowEditRange 对象的初始嵌套 For 循环不会达到您的预期，它仅适用于活动工作表。因此，当您尝试调用 AlloEditRanges.Add 时，这会失败，因为那里已经存在一个。

我猜你需要在 for 循环中调用 Delete 之前激活每个工作表，尽管我不喜欢将其作为“解决方案”，更多的是一种解决方法。