隔离Excel VBA脚本以运行aginst特定的工作表?

I have an Excel spreadsheet that contains 7 worksheets.
我有一个包含7个工作表的Excel电子表格。
I need the script below to be applied to only some of the worksheets (Sheet6 & Sheet7) whenever the document is saved.
每当保存文档时，我需要将下面的脚本只应用于一些工作表(Sheet6和Sheet7)。

I've spent several hours trying different modifications, must of which simply did not work. The VBA debugger does not throw any errors, and when I test the script it never appears to run.

我花了几个小时来尝试不同的修改，但这些修改都不奏效。VBA调试器不会抛出任何错误，当我测试脚本时，它似乎永远不会运行。

How can the script below be modified to run against specific worksheets, whenever I save the document from any of the worksheet tabs?

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

Thank you

谢谢你！

VBA - Lock Cells & Protect Sheet On Save

The script below will lock cells that contain values, and then password protect the sheet before saving.

下面的脚本将锁定包含值的单元格，然后在保存之前对其进行密码保护。

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

Script Source

脚本源代码

3 个解决方案

#1

Change the ActiveSheet and use a For Each loop like so:

更改ActiveSheet并对每个循环使用a，如下所示:

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

#2

This should help you (you'll have messages to let you know when you are in the event and when it's started and over) :

这应该会对您有所帮助(您将会得到消息，让您知道您何时在事件中，何时开始和结束):

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

#3

The code can be significantly shorted (run time wise) by

代码可以大大缩短(运行时)

Using SpecialCells rather than looping through each cell
使用specialcell，而不是遍历每个单元格。
avoiding setting blank cells as being locked twice (minor compared to first point).
避免将空白单元设置为锁定两次(与第一点相比较小)。

updated

更新

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

#1