数据输入后锁定单元格

Posted 2023-03-16

【中文标题】数据输入后锁定单元格

【英文标题】：Lock Cells after Data Entry

【发布时间】：2012-05-01 09:45:31

【问题描述】：

我有一个由多个用户编辑的电子表格。为了防止篡改以前的数据，一旦输入数据并保存文件，单元格就会被锁定。不过，我在代码中有一些小错误：

即使用户手动保存然后退出应用程序，仍然会提示他们再次保存。

应在保存后在应用程序运行时锁定单元格，而不仅仅是在退出时锁定。以前我在 before_save 事件中有此代码，但即使取消了 save_as 事件，单元格也被锁定，所以我现在删除了代码。 已修复

（编辑：我刚刚意识到这个错误是多么明显。我什至在这个声明中说过！尝试在保存事件之后使用保存前事件子锁定单元格！）

代码

With ActiveSheet
    .Unprotect Password:="oVc0obr02WpXeZGy"
    .Cells.Locked = False
    For Each Cell In ActiveSheet.UsedRange
        If Cell.Value = "" Then
            Cell.Locked = False
        Else
            Cell.Locked = True
        End If
    Next Cell
    .Protect Password:="oVc0obr02WpXeZGy"
End With

工作簿打开、隐藏所有工作表并显示所有工作表子用于强制最终用户启用宏。完整代码如下：

Option Explicit
Const WelcomePage = "Macros"

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

    Dim ws As Worksheet
    Dim wsActive As Worksheet
    Dim vFilename As Variant
    Dim bSaved As Boolean

'Turn off screen updating
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

'Record active worksheet
 Set wsActive = ActiveSheet

'Prompt for Save As
If SaveAsUI = True Then
    vFilename = Application.GetSaveAsFilename("", fileFilter:="Excel Files (*.xls), *.xls")
    If CStr(vFilename) = "False" Then
        bSaved = False
    Else
        'Save the workbook using the supplied filename
        Call HideAllSheets
        ThisWorkbook.SaveAs vFilename
        Application.RecentFiles.Add vFilename
        Call ShowAllSheets
        bSaved = True
    End If
Else
    'Save the workbook
    Call HideAllSheets
    ThisWorkbook.Save
    Call ShowAllSheets
    bSaved = True
End If


'Restore file to where user was
wsActive.Activate
'Restore screen updates
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

'Set application states appropriately
If bSaved Then
    ThisWorkbook.Saved = True
    Cancel = True
Else
    Cancel = True
End If

End Sub

Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
    ThisWorkbook.Saved = True
End Sub

Private Sub HideAllSheets()
    Dim ws As Worksheet
    Worksheets(WelcomePage).Visible = xlSheetVisible
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
    Next ws
    Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
    Next ws
    Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

'Lock Cells upon exit save if data has been entered
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Cell As Range
With ActiveSheet
    .Unprotect Password:="oVc0obr02WpXeZGy"
    .Cells.Locked = False
    For Each Cell In ActiveSheet.UsedRange
        If Cell.Value = "" Then
            Cell.Locked = False
        Else
            Cell.Locked = True
        End If
    Next Cell
    .Protect Password:="oVc0obr02WpXeZGy"
End With
End Sub

谢谢:)

【参考方案1】：

它要求他们在退出之前保存，即使他们已经保存了，因为这些行：

'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True

您在保存后更改工作表（通过调用 ShowAllSheets），因此确实需要再次保存。 saveAs 代码也是如此。

【参考方案2】：

我通过使用另一个 IF 解决了第二个问题。这样可以确保只有在保存数据时才会锁定单元格：

'Lock Cells before save if data has been entered
    Dim rpcell As Range
With ActiveSheet
    If bSaved = True Then
    .Unprotect Password:="oVc0obr02WpXeZGy"
    .Cells.Locked = False
    For Each rpcell In ActiveSheet.UsedRange
        If rpcell.Value = "" Then
            rpcell.Locked = False
        Else
            rpcell.Locked = True
        End If
    Next rpcell
    .Protect Password:="oVc0obr02WpXeZGy"
    Else
    MsgBox "The LogBook was not saved. You are free to edit the RP Log again", vbOKOnly, "LogBook Not Saved"
    End If
End With