Question

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

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

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

Answer 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

将其应用于您的代码就像这样（ UNTESTED ）

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

仅对公式单元格执行操作时出错

1 个答案: