データ入力後にセルをロックする

Question

私は複数のユーザーによって編集されたスプレッドシートを持っています。以前のデータの改ざんを防ぐため、データが入力されてファイルが保存されると、セルはロックされます。しかし、コードにいくつか小さなバグがあります。

1. ユーザーが手動で保存してからアプリケーションを終了しても、再度保存するように求められます。

2. セルは、アプリケーションの実行中および終了時でなく、保存後にロックする必要があります。以前は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 

ブックオープンは、すべてのシートを隠し、SUBSが可能マクロにエンドユーザに強制するために使用されるすべてのシートを示します。ここでは、完全なコードは次のとおりです。

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 

感謝:)

Answer 1

彼らがすでにあるため、これらのラインを保存しているにもかかわらず、終了する前に保存するためにそれらを求めて：

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

あなたが変化していますワークシートを保存した後（ShowAllSheetsを呼び出して）、再度保存する必要があります。 saveAsコードも同じです。

Answer 2

別のIFを使用して2番目の問題を修正しました。これにより、データが保存される場合にのみセルがロックされます。

'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