vba - 仅在保存在新工作簿中时对包含公式的单元格进行单元格保护

Question

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

例如，考虑我的工作簿 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

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

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

我循环了这些操作以减少冗余代码。根据您的实际命名约定，您可能需要进行一些更改。

请注意，解锁.Cells时，您仅引用Worksheet.UsedRange property内的单元格。 。如果您想解锁更大范围的单元格，则可能需要对此进行修改。