首页 文章

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

提问于
浏览 次
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”的所有单元格（包含或不包含公式）都受到保护 . 我只想保护含有配方的细胞 .

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

excel vba excel-vba

1 回答

  • 1

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

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

    回复于

相关问题