仅当具有公式的单元格保存在新的工作簿中时才对单元格进行保护

我有一个工作簿，其中包含一些单元格中的公式。 我想保护包含这些公式的单元格进行编辑，但我不想保护包含非公式的单元格。 当我保存工作表时，我希望公式的单元保护能够传播到新的工作表中。

例如考虑我的工作簿A包含两张纸（Sheet1和Sheet2）。

Sub protect() Dim pwd As String pwd = InputBox("entrer a password", Title:="Password") Worksheets("Sheet1").Activate Worksheets("Sheet1").Copy Cells.Select Cells.SpecialCells(xlCellTypeFormulas).Locked = True Worksheets("Sheet1").Protect pwd, True, True, True, True ActiveWorkbook.SaveAs Filename:="myfile1" ActiveWorkbook.Close ThisWorkbook.Activate Worksheets("Sheet2").Activate Worksheets("Sheet2").Copy Cells.Select Cells.SpecialCells(xlCellTypeFormulas).Locked = True Worksheets("Sheet2").Protect pwd, True, True, True, True ActiveWorkbook.SaveAs Filename:="myfile2" ActiveWorkbook.Close ThisWorkbook.Activate End Sub 

当我运行这个代码时，“myfile1”和“myfile2”的所有单元格（包含公式）都受到保护。 我只想保护含有配方的细胞。

我如何才能完成只保护公式的单元格？

Answer 1

默认情况下，工作表中的所有单元格都被locking。 您可以更改它们，因为工作表不受保护。 你不需要locking公式; 你需要解锁空白和常量。

 Cells.SpecialCells(xlCellTypeBlanks).Locked = False Cells.SpecialCells(xlCellTypeConstants).Locked = False 

依赖Range.Activate和Worksheet.Activate命名您的子程序与您正在运行的主要命令相同不是好主意。

 Sub myProtect() Dim pwd As String, s As Long pwd = InputBox("entrer a password", Title:="Password") With ThisWorkbook For s = 1 To 2 With .Worksheets("Sheet" & s) .Copy End With With ActiveWorkbook With .Worksheets(1) .UsedRange On Error Resume Next '<~~just in case there are no constants or blanks .Cells.SpecialCells(xlCellTypeBlanks).Locked = False .Cells.SpecialCells(xlCellTypeConstants).Locked = False On Error GoTo 0 .protect pwd, True, True, True, True End With .SaveAs Filename:="myfile" & s, FileFormat:=xlOpenXMLWorkbook .Close SaveChanges:=False End With Next s End With End Sub 

为了减less多余的代码，我采取了行动。 根据您的实际命名约定，您可能需要进行一些更改。

请注意，解锁.Cells ，您只能引用Worksheet.UsedRange属性中的单元格。 如果您想解锁更大范围的单元格，则可能必须进行修改。