vba 数据输入后锁定单元格

Lock Cells after Data Entry

提问by Alistair Weir

I have a spreadsheet that is edited by multiple users. To prevent tampering with previous data the cells are locked once data has been entered and the file saved. I have a few small bugs in the code though:

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

1. Even if the user has saved manually and then exits the application they are still prompted to save again.

2. The cells should be locked after a save when the application is running and not just when it is exited. Previously I had this code in the before_save event but the cells were being locked even if a save_as event was cancelled so I removed the code for now. Fixed

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

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

(Edit: I've just realised how obvious this error was. I even said it in this statement! Trying to lock cells after a save event using a before save event sub! )

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

Code

代码

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

The workbook open, hide all sheets and show all sheets subs are used to force the end user into enabling macros. Here is the full code:

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

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

Thanks :)

谢谢 ：）

采纳答案by lnafziger

It is asking for them to save before exiting even though they have already saved because of these lines:

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

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

You are changing the worksheet after saving it (by calling ShowAllSheets) so it does need to be saved again. The same is true of the saveAs code.

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

回答by Alistair Weir

I fixed the second problem by using another IF. This ensures the cells are only locked if the data is saved:

我通过使用另一个 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