保护公式不被修改

Sub 保护公式不背修改()

If ActiveSheet.ProtectContents = True Then MsgBox '当前工作表已保护，程序无法执行！', 64, '提示'

On Error Resume Next

Cells.Locked = False  '取消所有单元格的锁定属性

Cells.FormulaHidden = False '将隐藏公式也取消

With Cells.SpecialCells(xlCellTypeFormulas, 23) '对公式区域进行操作

If Err.Number = 1004 Then MsgBox '当前表不存在公式': Exit Sub

'如果错误提示，并退出程序

.Locked = True '锁定所有公式区

.FormulaHidden = True '隐藏所有公式区

'保护工作表（允许用户插入行、设置格式、删除行列、编辑对象等）

ActiveSheet.Protect Password:='', DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _

AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _

AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

End With

End Sub