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

时间:2014-07-16 12:31:16

标签: excel vba runtime-error

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

代码第一次运行顺利,但是当我第二次运行它时,我得到运行时1004错误“应用程序定义或对象定义的错误”

我想我可能在下面的页面上找到了一些解释: http://support.microsoft.com/kb/178510 但我无法弄清楚..

有人可以帮我一把吗?

我的代码如下。

根据首先受保护的工作表,它是这一行

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

或抛出erorr的以下行

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

2 个答案:

答案 0 :(得分:0)

根据您发布的知识库文章,我认为问题出在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

答案 1 :(得分:0)

一个老问题,但是我在代码中正面临一个类似的问题,在我看来,为了使AlloEditRange.Delete函数起作用,工作表本身必须处于活动状态。因此,我相信您最初用于删除所有AllowEditRange对象的嵌套For循环不会达到您的期望,它仅在活动工作表上起作用。因此,当您尝试调用AlloEditRanges.Add时,进一步失败了,因为已经有一个了。

我想您需要先激活每个工作表才能调用循环中的Delete(删除),尽管我不喜欢将其作为“解决方案”,但需要更多解决方法。