Excel 输入数据后锁定单元格
我有一个由多个用户编辑的电子表格。为防止篡改以前的数据,一旦输入数据并保存文件,单元格将被锁定。但代码中有一些小错误:Excel 输入数据后锁定单元格,excel,locking,before-save,vba,Excel,Locking,Before Save,Vba,我有一个由多个用户编辑的电子表格。为防止篡改以前的数据,一旦输入数据并保存文件,单元格将被锁定。但代码中有一些小错误: 即使用户手动保存,然后退出应用程序,仍会提示用户再次保存 应用程序运行时,而不仅仅是退出时,保存后应锁定单元格。以前我在before_save事件中有此代码,但即使save_as事件被取消,单元格也被锁定,因此我暂时删除了此代码固定 (编辑:我刚刚意识到这个错误是多么明显。我甚至在这句话中说过!尝试在保存事件后使用“保存前事件”子节点锁定单元格!) 代码 With Active
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
谢谢:)它要求他们在退出之前保存,即使他们已经保存了,因为这些行:
'Save the workbook
Call HideAllSheets
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
您在保存工作表后(通过调用ShowAllSheets)正在更改工作表,因此需要再次保存工作表。saveAs代码也是如此。我通过使用另一个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