如果已输入数据,则单击“保存”

时间:2012-05-09 09:24:56

标签: excel-vba locking vba excel

这是此问题的后续跟进,Lock Cells after Data Entry。我从提出这个问题的过程中取得了进展,但遇到了更多问题,所以觉得我应该问一个新问题。该工作簿由多个用户编辑。为防止篡改先前的数据,一旦输入数据并保存文件,单元格就会被锁定。

我在代码中有几个小错误:

  1. 如果用户选择SaveAs,则尝试保存现有文件,通常是“您要替换此文件吗?”出现对话框。如果用户选择“否”,则表示存在运行时错误。我已经在下面的代码中突出显示了错误的位置,但我不确定如何修复它。

  2. 如果用户输入了数据,则尝试退出并使用关闭时出现的保存对话框保存文件,但保存文件但数据未锁定。我一直试图调用我的主代码来锁定退出保存的单元格,但我一直遇到参数而不是可选错误。

  3. 以下是完整代码:

    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
    

    我愿意接受更好的方法,但仍然没有解决第一个问题。

1 个答案:

答案 0 :(得分: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

我还没有完全测试上面的内容,但它应该给你一些想法。