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

当我运行此代码时，＆＃34; myfile1＆＃34;的所有单元格（包含或不包含公式）和＆＃34; myfile2＆＃34;受到保护。我只想保护含有配方的细胞。

如何通过公式仅保护细胞？

Answer 1

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

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中的单元格。如果要解锁更大范围的单元格，可能需要修改此项。

仅在保存在新工作簿中时具有公式的单元格的单元格保护

1 个答案: