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

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

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 

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

在使用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 

应用到你的代码将是这样(未testing)

 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 
Interesting Posts