隔离Excel VBA脚本来运行aginst特定的工作表？

• 我有一个包含7个工作表的Excel电子表格。
• 只要保存文档，我就需要将下面的脚本应用于一些工作表 （ Sheet6和Sheet7 ）。

我已经花了几个小时尝试不同的修改，其中的一些根本不起作用。 VBAdebugging器不会抛出任何错误，当我testing脚本时，它永远不会运行。

每当我从任何工作表选项卡中保存文档时，如何修改下面的脚本以针对特定的工作表运行？

谢谢

---

VBA – locking单元格和保存表保存

下面的脚本将locking包含值的单元格，然后在保存之前用密码保护表单。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) On Error Resume Next Dim Cell As Range With ActiveSheet .Unprotect Password:="" .Cells.Locked = False For Each Cell In Application.ActiveSheet.UsedRange If Cell.Value = "" Then Cell.Locked = False Else Cell.Locked = True End If Next Cell .Protect Password:="" 'Protect with blank password, you can change it End With Exit Sub End Sub 

脚本源

Answer 1

更改ActiveSheet并使用For Each循环，如下所示：

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) On Error Resume Next Dim Cell As Range For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet") With Sheets(sh) .Unprotect Password:="" .Cells.Locked = False For Each Cell In Application.ActiveSheet.UsedRange If Cell.Value = "" Then Cell.Locked = False Else Cell.Locked = True End If Next .Protect Password:="" End With Next End Sub 

Answer 2

这应该对你有所帮助（你会有消息让你知道你在什么时候，什么时候开始和结束）：

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim Cell As Range MsgBox "Event Workbook_BeforeSave Launched", vbInformation + vbOKOnly, "Started" On Error GoTo ErrHandler ReTry: With Sheet6 .Unprotect Password:="" .Cells.Locked = False For Each Cell In .UsedRange If Cell.Value = "" Then Cell.Locked = False Else Cell.Locked = True End If Next Cell .Protect Password:="" 'Protect with blank password, you can change it End With With Sheet7 .Unprotect Password:="" .Cells.Locked = False For Each Cell In .UsedRange If Cell.Value = "" Then Cell.Locked = False Else Cell.Locked = True End If Next Cell .Protect Password:="" 'Protect with blank password, you can change it End With MsgBox "Event Workbook_BeforeSave Over", vbInformation + vbOKOnly, "Finished" Exit Sub ErrHandler: MsgBox "Error " & Err.Number & " :" & vbCrLf & _ Err.Description Resume ReTry End Sub 

Answer 3

代码可以显着缩短（运行时间明智）通过

• 使用SpecialCells而不是循环遍历每个单元格
• 避免将空白单元格设置为locking两次（与第一个点相比较小）。

更新

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) For Each sh In Array("Sheet1", "AnotherSheet", "OtherSheet") With Sheets(sh) .Unprotect .Cells.Locked = True On Error Resume Next .Cells.SpecialCells(xlBlanks).Locked = False On Error GoTo 0 .Protect End With Next End Sub