如何锁定复制的工作簿的所有单元格？

Question

我试图在保存时创建我的工作簿的副本，但是当我创建该副本时，锁定所有单元格以防止它们被更改。

这是我的...

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim FName As String
Dim FPath As String
Dim NewBook As Workbook

FPath = ThisWorkbook.Path & "\" '& FName
FName = "Saved File" & Format(Date, "YYMMDD") & ".xlsx"

Set NewBook = Workbooks.Add

Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs Filename:=FPath & FName, FileFormat:=51
ActiveWorkbook.Close
Application.DisplayAlerts = True

'NewBook.SaveAs Filename:=FPath & FName, FileFormat:=51

Application.DisplayAlerts = False
NewBook.Close
Application.DisplayAlerts = True


End Sub

如有任何帮助，我们将不胜感激。非常感谢

Answer 1

在您的情况下，您可以使用 usedrange.locked 锁定新工作簿的整个使用范围。但是，在工作簿受到保护之前，这不会阻止编辑，因此最好也使用 worksheet.protect 进行编辑。完整代码：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim FName As String
Dim FPath As String
ThisWorkbook.Activate
FPath = ThisWorkbook.Path & "\" '& FName
FName = "Saved File" & Format(Date, "YYMMDD") & ".xlsx"


Application.DisplayAlerts = False
ThisWorkbook.Sheets.Copy
With ActiveWorkbook
.Sheets(1).UsedRange.Locked = True
.Sheets(1).Protect ""
.SaveAs Filename:=FPath & FName, FileFormat:=51
.Close
End With
Application.DisplayAlerts = True

End Sub

请注意，usedrange 通常不是覆盖整个范围的最佳做法，因为它有时会太大。但是，在您的情况下，您需要确保覆盖 sheet 中的所有单元格。由于默认情况下所有单元格在未更改时都受到保护，因此 usedrange 将在这里很好地解决其余问题。

编辑，我忽略了大部分代码，因为只有 protect 与问题相关。但是，根据评论，这会导致问题。发生的情况是您创建一个新工作簿，然后使用您的代码复制该工作簿。这也会自动创建一个新工作簿。这是保存的那个， newbook 没有任何改变就关闭了。我删除了这部分代码。 ActiveWorkbook你复制之后应该就是你复制的那个数据了，所以我就把这个锁定保存了

如何锁定复制的工作簿的所有单元格？

How do I lock all cells of a copied workbook?

excel

vba

locking

copy