セルロックオンデータが入力されている場合

Question

これはこの質問のフォローアップLock Cells after Data Entryです。私はその質問をすることから進んだが、より多くの問題に遭遇したので、新しい質問をするべきだと感じた。ブックは複数のユーザーによって編集されます。以前のデータの改ざんを防ぐため、データが入力されてファイルが保存されると、セルはロックされます。次に、ユーザは、SaveAsに選択し、通常は既存のファイルに上書き保存しようとした場合

1. ：

   私はコード内の小さなバグのカップルを持っている「あなたはこのファイルを置き換えますかを？」ダイアログが表示されます。ユーザーがnoを選択した場合、実行時エラーが発生します。私は以下のコードでどこにエラーがあるのか​​を強調しましたが、私はそれを修正する方法がわかりません。

2. ユーザーがデータを入力した場合、閉じるときに表示される保存ダイアログボックスを使用してファイルを終了して保存しようとすると、ファイルは保存されますが、データはロックされません。私は退出時にセルをロックするためにメインコードを呼び出そうとしていましたが、オプションのエラーではなく引き数に遭遇しています。

   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 

私はより良い方法の提案に開放され、まだ最初の問題を解決していません。

Private Function SaveSheet(Optional fileName) As Boolean 

HideAllSheets 

If fileName = "" Then 
    ThisWorkbook.Save 
    SaveSheet = True 
Else 
    Application.DisplayAlerts = False 

    If Dir(fileName) <> "" Then 
     If MsgBox("Worksheet exists. Overwrite?", vbYesNo, "Exists") = vbNo Then Exit Function 
    End If 

    ThisWorkbook.saveAs fileName 
    SaveSheet = True 

    Application.DisplayAlerts = True 
End If 

ShowAllSheets 

End Function 

など何かにあなたの元のコードを変更します：

If SaveAsUI Then 
    If 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.", _ 
     vbYesNo, "Are you sure?" _ 
    ) = vbYes Then 
     vFilename = Application.GetSaveAsFilename("", fileFilter:="Excel Files (*.xls), *.xls") 

     If vFilename <> "" Then 
      If SaveSheet(vFilename) Then bSaved = True 
     End If 
    End If 
Else 
    If MsgBox(_ 
     "Are you sure you want to save? Data entered cannot be edited after saving", _ 
     vbYesNo, "Save?" _ 
    ) = vbYes Then 
     If SaveSheet("") Then bSaved = True 
    End If 
End If 

私は完全にテストされていませんでした

Answer 1

一つの可能​​性はそうのような、機能を保存するには、独自の確認を書くことですしかし、それはあなたにいくつかのアイデアを与える必要があります。