数据输入后锁定单元格

问题描述

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

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




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

（编辑：我刚刚意识到这个错误是多么明显甚至在此声明中表示！尝试在保存事件之后使用保存事件sub锁定单元格！）

代码

 使用ActiveSheet 
 .Unprotect密码：=oVc0obr02WpXeZGy
 .Cells.Locked = False 
对于每个单元格在ActiveSheet.UsedRange 
如果Cell.Value =然后
 Cell.Locked = False 
 Else 
 Cell.Locked = True 
 End If 
 Next Cell 
 .Protect密码：=oVc0obr02WpXeZGy
结束
  

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

  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 
 
'关闭屏幕更新
应用程序
 .EnableEvents = False 
 .ScreenUpdating = False 
结束
 
'记录活动工作表
设置wsActive = ActiveSheet 
 
'提示保存为
如果SaveAsUI = True然后
 vFilename = Application.GetSaveAsFilename（，fileFilter：=Excel文件（* .xls），* .xls）
如果CStr（vFilename）=False然后
 bSaved = False 
 Else 
'使用提供的文件保存工作簿
调用HideAllSheets 
 ThisWorkbook.SaveAs vFilename 
 Application.RecentFiles.Add vFilename 
调用ShowAllSheets 
 bSaved = True 
 End If 
 Else 
'保存工作簿
调用HideAllSheets 
 ThisWorkbook.Save 
调用ShowAllSheets 
 bSaved = True 
 End If 
 
 
'将文件还原到用户
 wsActive.Activate 
'还原屏幕更新
使用应用程序
 .ScreenUpdating = True 
 .EnableEvents = True 
结束
 
'正确设置应用程序状态
如果bSaved然后
 ThisWorkbook.Saved = True 
取消= True 
 Else 
取消= True 
如果
 
结束Sub 
 
私人子工作簿_Open（）
 Application.ScreenUpdating = False 
调用ShowAllSheets 
 Application.ScreenUpdating = True 
 ThisWorkbook.Saved = True 
 End Sub 
 
 Private Sub HideAllSheets（） 
 Dim ws As Worksheet 
工作表（WelcomePage）.Visible = xlSheetVisible 
对于每个ws在ThisWorkbook.Worksheets 
如果不是ws.Name = WelcomePage然后ws.Visible = xlSheetVeryHidden 
下一个ws 
工作表（WelcomePage）.Activate 
 End Sub 
 
 Private Sub ShowAllSheets（）
 Dim ws As Worksheet 
对于每个ws在ThisWorkbook.Worksheets 
如果不是ws.Name = WelcomePage然后ws.Visible = xlSheetVisible 
下一个ws 
工作表（WelcomePage）.Visible = xlSheetVeryHidden 
 End Sub 
 
'在退出时锁定单元格如果输入了数据，则保存
 Private Sub Workbook_BeforeClose（Cancel As Boolean）
 Dim Cell As Range 
使用ActiveSheet 
 .Unprotect密码：=oVc0obr02WpXeZGy
 .Cells.Locked = False 
对于ActiveSheet.UsedRange 
中的每个单元格如果Cell.Value =然后
 Cell.Locked = False 
 Else 
 Cell.Locked = True 
 End If 
 Next Cell 
 .Protect密码：=oVc0obr02WpXeZGy
结束
 End Sub 
  

谢谢： p>

解决方案

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

 '保存工作簿
调用HideAllSheets 
 ThisWorkbook.Save 
调用ShowAllSheets 
 bSaved = True 
  

在保存工作表之后（通过调用ShowAllSheets）更改工作表，因此需要重新保存。 saveAs代码也是如此。

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

(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 :)

解决方案

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.

这篇关于数据输入后锁定单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！