VBA 允许用户格式化锁定工作表上的单元格

Question

我的工作簿上有一些代码：

Sub ProtectionOptions()
 
'PURPOSE: Protect Worksheet But Allow User to Format Cells

Dim myPassword As String

'Input Password to Variable
    myPassword = "SSD84006"

'Protect Worksheet (Allow Formatting Cells)
    ActiveSheet.Protect Password:=(myPassword), AllowFormattingCells:=True
    
    
'Protect Worksheet (Allow Formatting Cells)
    ActiveSheet.Protect _
        Password:=(myPassword), _
        AllowFormattingCells:=True

 
End Sub

这允许用户能够在受密码保护的工作表上设置单元格格式。

我已将其作为子例程添加到另一个例程中，但无论我将其添加到哪个例程中，它只允许在工作簿重新启动后进行格式化。

即使我将其添加到我的代码中以创建新工作簿：

Sub Add_New_Briefing()
    Application.EnableEvents = False
    Call fileProtection(False, Worksheets("1900 01 01"))
    Worksheets("1900 01 01").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = InputBox("Briefing Sheet (Date of the Monday) " & vbNewLine & "In the format of YYYY MM DD" & vbNewLine & "So 23/12/2024 would be entered 2024 12 23" & vbNewLine & "Note - there are spaces either side of MM")
    
    Call fileProtection(True)
    Application.EnableEvents = True
End Sub

我仍然需要重新启动工作簿才能进行格式化。

我使用的其他保护代码是

Sub fileProtection(ByVal blnProtect As Boolean, Optional ByVal SpecificSheet As Object)
Dim ws As Worksheet
Const pw = "SSD84006"
With ThisWorkbook
    If blnProtect Then
        .Protect pw
    Else
        .Unprotect pw
    End If
    
    If SpecificSheet Is Nothing Then
        For Each ws In .Worksheets
            If blnProtect Then
                ws.Protect pw
            Else
                ws.Unprotect pw
            End If
        Next
    Else
        With SpecificSheet
            If blnProtect Then
                .Protect pw
            Else
                .Unprotect pw
            End If
        End With
    End If
End With
End Sub

Answer 1

您似乎使用了错误的文件保护例程。 将两个例程合并为一个例程可以防止这种错误以及两个例程之间可能发生的冲突（如果将来进行修改）。

Sub fileProtection(ByVal blnProtect As Boolean, Optional ByVal SpecificSheet As Worksheet, Optional AllowFormattingCells = False)
    Dim ws As Worksheet
    Const pw = "SSD84006"
    With ThisWorkbook
        If blnProtect Then
            .Protect pw
        Else
            .Unprotect pw
        End If
    
        If SpecificSheet Is Nothing Then
            For Each ws In .Worksheets
                If blnProtect Then
                    ws.Protect pw, AllowFormattingCells:=AllowFormattingCells
                Else
                    ws.Unprotect pw, AllowFormattingCells:=AllowFormattingCells
                End If
            Next
        Else
            With SpecificSheet
                If blnProtect Then
                    .Protect pw, AllowFormattingCells:=AllowFormattingCells
                Else
                    .Unprotect pw, AllowFormattingCells:=AllowFormattingCells
                End If
            End With
        End If
    End With
End Sub

用途：

Sub Add_New_Briefing()
    Application.EnableEvents = False
    Call fileProtection(False, Worksheets("1900 01 01"))
    Worksheets("1900 01 01").Copy After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = InputBox("Briefing Sheet (Date of the Monday) " & vbNewLine & "In the format of YYYY MM DD" & vbNewLine & "So 23/12/2024 would be entered 2024 12 23" & vbNewLine & "Note - there are spaces either side of MM")
    
    Call fileProtection(True, AllowFormattingCells:= True)
    Application.EnableEvents = True
End Sub