Home Articles

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

Asked
Viewed 699 times
3

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

例如,考虑我的工作簿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”的所有单元格(包含或不包含公式)都受到保护 . 我只想保护含有配方的细胞 .

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

1 Answer

  • 1

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

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

    依赖于Range .ActivateWorksheet.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中的单元格 . 如果要解锁更大范围的单元格,可能必须修改此项 .

Related