循环保护工作表

时间:2015-08-26 05:55:33

标签: excel vba

以下代码用于锁定符合工作簿的每个工作表中条件的单元格。代码在单个工作表上运行正常,但是当我想应用于整个工作簿时,错误消息并不能将锁定属性设置为范围类"。

工作簿循环过程也是正确的,有人能告诉我导致错误的原因是什么吗?

非常感谢!代码如下,对不起,我不知道如何在这里显示正确的格式:

Sub selectnumbers()
    Dim ws_count As Integer
    Dim n As Integer
    ws_count = ActiveWorkbook.Worksheets.Count
    For n = 2 To ws_count

        Dim rng As Range
        Dim cell As Range
        Dim i As Range
        Set rng = Nothing

        For Each cell In ActiveSheet.UsedRange
          If IsNumeric(cell) = False Or cell.Interior.Pattern = xlLightUp Or cell = "" Then
           If rng Is Nothing Then
            Set rng = cell
              Else
              Set rng = Application.union(rng, cell)
            End If
          End If
        End If
        Next cell

        If Not rng Is Nothing Then
        rng.Select
        End If

        Selection.Locked = True

        ActiveSheet.Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

    Next n

End Sub

1 个答案:

答案 0 :(得分:2)

在嵌套End If关闭之前似乎还有一个额外的For Each cell In .UsedRange

我认为您的主要问题是依赖ActiveSheet propertyFor n = 2 To ws_count并未将控制权转移到下一个工作表。 ActiveSheet保留了焦点和控制权。

Sub selectnumbers()
    Dim ws_count As Long, n As Long
    Dim rng As Range, cell As Range, i As Range

    ws_count = ActiveWorkbook.Worksheets.Count
    For n = 2 To ws_count
        With Worksheets(n)

            Set rng = Nothing

            For Each cell In .UsedRange
                If Not IsNumeric(cell) Or cell.Interior.Pattern = xlLightUp Or cell = "" Then
                    If rng Is Nothing Then
                        Set rng = cell
                    Else
                        Set rng = Application.Union(rng, cell)
                    End If
                End If
            Next cell

            If Not rng Is Nothing Then
                rng.Locked = True
            End If

            .Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
                AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

        End With
    Next n

End Sub

我已使用With ... End With statement将控件传递给下一个工作表。