Блокировка соты при сохранении, если данные введены

Question

Это вопрос из этого вопроса, Lock Cells after Data Entry. Я перешел от вопроса к этому вопросу, но столкнулся с большим количеством проблем, поэтому я должен задать новый вопрос. Рабочая книга редактируется несколькими пользователями. Чтобы предотвратить несанкционированное использование предыдущих данных, ячейки блокируются после ввода данных и сохранения файла.

У меня есть несколько небольших ошибок в коде:

1. Если пользователь выбирает SaveAs затем пытается сохранить поверх существующего файла обычного "Хотите ли вы заменить этот файл? появится диалоговое окно. Если пользователь не выбирает, есть ошибка времени выполнения. Я подсчитал, где ошибка в коде ниже, но я не уверен, как ее исправить.

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 

Спасибо :)

Редактировать

Сейчас я решение задачи 2 в обход по умолчанию в Excel «вы хотите спасти?' при этом:

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 

Я открыт для предложений о лучшем способе и до сих пор не решил первую проблему.

Answer 1

Одна возможность состоит в том, чтобы написать свои собственные подтверждения в функции сохранения, например, так:

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 

Я не полностью протестировали выше, но он должен дать вам некоторые идеи.