1

我试图遍历文件夹中每个工作簿中的每个工作表,并确保只有包含公式的单元格被锁定。我已经使用代码来锁定每个工作表中的所有单元格,并使用代码来锁定工作表中的每个公式,几个月以来我已经成功了,所以我基本上将这两段代码混合在一起来得到这个:

Sub LockAllFormulas()

Dim myOldPassword As String
Dim myNewPassword As String
Dim ws As Worksheet
Dim FileName As String
Dim rng As Range

myOldPassword = InputBox(Prompt:="Please enter the previously used password.", Title:="Old password input")
myNewPassword = InputBox(Prompt:="Please enter the new password, if any.", Title:="New password input")

FileName = Dir(CurDir() & "\" & "*.xls")
Do While FileName <> ""
Application.DisplayAlerts = False
If FileName <> "ProtectionMacro.xlsm" Then
    MsgBox FileName
    Workbooks.Open (CurDir & "\" & FileName)
    For Each ws In ActiveWorkbook.Worksheets
        If Not Cells.SpecialCells(xlCellTypeFormulas) Is Nothing Then
            ActiveWorkbook.ActiveSheet.Unprotect Password:=myOldPassword
            ActiveWorkbook.ActiveSheet.Cells.Locked = False
            For Each rng In ws.Cells.SpecialCells(xlCellTypeFormulas)
                rng.Locked = True
            Next rng
            ActiveWorkbook.ActiveSheet.Protect Password:=myPassword
        End If
    Next ws
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End If
FileName = Dir()
Loop
Application.DisplayAlerts = True


End Sub

每次我运行它都会显示 400 错误。每当代码运行到其中没有任何代码的工作表时,该错误与我得到的错误相匹配,但我认为我在添加时解决了该问题:

If Not Cells.SpecialCells(xlCellTypeFormulas) Is Nothing Then

任何想法还有什么可能出错的?

4

1 回答 1

1

使用 时SpecialCells,您必须非常小心。我所做的是将它们存储在夹在 OERN 之间的范围内,然后检查它们不是什么都没有。这是一个例子

Dim rng  As Range

On Error Resume Next
Set rng = ws.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If Not rng Is Nothing Then
    '
    '~~> Rest of the code
    '
End If

将其应用于您的代码将是这样的(未测试

Dim LockedRange As Range

For Each ws In ActiveWorkbook.Worksheets
    With ws
        On Error Resume Next
        Set LockedRange = .Cells.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0

        If Not LockedRange Is Nothing Then
            .Unprotect Password:=myOldPassword

            .Cells.Locked = False
            LockedRange.Locked = True

            .Protect Password:=myPassword
        End If

        Set LockedRange = Nothing
    End With
Next ws
于 2014-08-06T18:15:55.270 回答