これは、この質問のフォローアップです。 Lock Cells after Data Entry . 私はその質問をすることから進歩しましたが、さらに問題に遭遇したので、新しい質問をする必要があると感じました. ワークブックは複数のユーザーによって編集されています。以前のデータの改ざんを防ぐために、データが入力されてファイルが保存されると、セルはロックされます。
コードにいくつかの小さなバグがあります。
ユーザーが
SaveAs
既存のファイルに保存しようとすると、通常の「このファイルを置き換えますか?」というメッセージが表示されます。ダイアログが表示されます。ユーザーが no を選択すると、実行時エラーが発生します。以下のコードでエラーの場所をハイライトしましたが、修正方法がわかりません。ユーザーがデータを入力して終了し、閉じるときに表示される保存ダイアログ ボックスを使用してファイルを保存しようとすると、ファイルは保存されますが、データはロックされません。メインコードを呼び出して、終了保存時にセルをロックしようとしましたが、オプションのエラーではなく引数が引き続き発生します。
完全なコードは次のとおりです。
Option Explicit
Const WelcomePage = "Macros"
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Written by Alistair Weir (alistair.weir@communitypharmacyscotland.org.uk, http://alistairweir.blogspot.co.uk/)
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
MsgBox "Are you sure you want to save? Data entered cannot be edited once the file has been saved. Press cancel on the next screen to edit your data or continue if you are sure it is correct.", vbCritical, "Are you sure?"
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
'--> The vFilename Variant in the next line is the problem **
'--> when trying to overwrite an existing file **
ThisWorkbook.SaveAs vFilename
Application.RecentFiles.Add vFilename
Call ShowAllSheets
bSaved = True
End If
Else
'Save the workbook, prompt if normal save selected not save As
Call HideAllSheets
If MsgBox("Are you sure you want to save? Data entered cannot be edited after saving", vbYesNo, "Save?") = vbYes Then
ThisWorkbook.Save
Call ShowAllSheets
bSaved = True
Else
Cancel = True
End If
Call ShowAllSheets
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
'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
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
'Called to hide all the sheets but enable macros page
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
'Called to show the data sheets when macros are enabled
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
ありがとう :)
編集
今のところ、Excel のデフォルトの「保存しますか?」をバイパスして問題 2 を解決しています。これを行うことによって:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If MsgBox("Are you sure you want to quit? Any unsaved changes will be lost.", vbYesNo, "Really quit?") = vbNo Then
Cancel = True
Else
ThisWorkbook.Saved = True
Application.Quit
End If
End Sub
私はより良い方法の提案を受け入れていますが、まだ最初の問題は解決していません。