excel - 在 BeforeSave 事件期间防止关闭

Question

问题:

用户尝试关闭他们已更改的文件。出现提示询问他们是否要保存，然后单击"is"。如果 BeforeSave 事件中有取消保存的代码，有没有办法也取消关闭？

背景:

我们经常使用“空白文件”、带有公式的预格式化文件，以便用户可以打开、输入数据并以新文件名保存。正是最后一步导致了问题。用户会将他们的数据保存到空白文件中，这意味着我们必须将其恢复到原始状态(清除数据、重新输入已删除/覆盖的公式、恢复对格式的更改等)。

为了防止这种情况，我将以下代码添加到所有空白文件中:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If instr(UCase$(ThisWorkbook.Name), "BLANK") <> 0 then
        If SaveAsUI = False Then
            MsgBox "This is the blank file. You can't save it. " _
              & "Please choose 'Save As' and save with a new file name.", _
              vbExclamation, "Can't Save Blank"
            Cancel = True
        End If
    End If
End Sub

如果用户尝试将数据保存到空白文件，他们将收到一条消息，告诉他们不能，并改为使用“另存为”对话框。如果我需要对空白文件进行更改，我可以使用“另存为”对话框使用相同的文件名进行保存。

问题出在我对空白文件进行更改并尝试关闭该文件时。将出现提示询问我是否要保存更改。没有考虑它，我会单击"is"。然后我的代码将被触发以防止保存并按预期通知我。但是，当我在消息上单击“确定”时，文件会立即关闭而不保存更改。

我想要的是某种方法来防止文件在保存被取消时关闭。

Answer 1

我从那里获取代码并对其进行了修改。

save as dialog excel code

我希望它可以解决您的问题，或者至少在进行一些小的更改后可以解决。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim varResult As Variant
    Dim ActBook As Workbook

    'displays the save file dialog
    varResult = Application.GetSaveAsFilename(FileFilter:= _
             "Excel Files (*.xlsx), *.xlsx", Title:="Save As", _
            InitialFileName:=Application.ActiveWorkbook.Path)

    'checks to make sure the user hasn't canceled the dialog
    If varResult <> False Then
        ActiveWorkbook.SaveCopyAs Filename:=varResult '_
        'FileFormat:=xlWorkbookNormal
        Exit Sub
    End If

End Sub


' No it is just in case the user doesn't want to save the file and cancels the first dialog

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If InStr(UCase$(ThisWorkbook.Name), "BLANK") <> 0 Then
        If SaveAsUI = False Then
            MsgBox "This is the blank file. You can't save it. " _
              & "Please choose 'Save As' and save with a new file name.", _
              vbExclamation, "Can't Save Blank"
            Cancel = True
        End If
    End If
End Sub

编辑:

按下关闭按钮后:

每次更改时都会弹出一个“另存为”窗口，保存副本后它会关闭，之后不再弹出窗口

如果没有进行任何更改，它只会关闭工作簿

编码:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim varResult As Variant
    Dim ActBook As Workbook

    If InStr(UCase$(ThisWorkbook.Name), "BLANK") <> 0 Then
        If Not ThisWorkbook.Saved Then

            'displays the save file dialog
            varResult = Application.GetSaveAsFilename(FileFilter:= _
                     "Excel Files (*.xlsm), *.xlsm", Title:="Save As", _
                    InitialFileName:=Application.ActiveWorkbook.Path)

            'checks to make sure the user hasn't canceled the dialog
            If varResult <> False Then
                ActiveWorkbook.SaveCopyAs Filename:=varResult '_
                'FileFormat:=xlWorkbookNormal
                ThisWorkbook.Saved = True
                Exit Sub
            Else
                ThisWorkbook.Saved = True
            End If

        End If
    End If

End Sub


' Just in case the user presses save in options

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If InStr(UCase$(ThisWorkbook.Name), "BLANK") <> 0 Then
        If SaveAsUI = False Then
            MsgBox "This is the blank file. You can't save it. " _
              & "Please choose 'Save As' and save with a new file name.", _
              vbExclamation, "Can't Save Blank"
            Cancel = True
        End If
    End If
End Sub

最终版本

按下关闭按钮后:

每次进行更改时都会出现一个窗口，询问您是否要保存更改(可以取消它，说不或是)

如果选择"is"(默认按钮)，则会弹出“另存为”窗口，保存副本后它会关闭，之后不再弹出窗口

如果没有进行任何更改，它只会关闭工作簿

编码:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    Dim varResult As Variant
    Dim ActBook As Workbook
    Dim MsgBoxAnswer As Variant

    If InStr(UCase$(ThisWorkbook.Name), "BLANK") <> 0 Then
        If Not ThisWorkbook.Saved Then

            MsgBoxAnswer = MsgBox("Do you want to save changes?", vbYesNoCancel + vbExclamation + vbDefaultButton1, "Microsoft Office Excel")

            If MsgBoxAnswer = vbYes Then


                MsgBox "This is the blank file. Save it with a new file name.", _
                vbExclamation, "Can't Save Blank"

                'displays the save file dialog
                varResult = Application.GetSaveAsFilename(FileFilter:= _
                         "Excel Files (*.xlsm), *.xlsm", Title:="Save As", _
                        InitialFileName:=Application.ActiveWorkbook.Path)

                'checks to make sure the user hasn't canceled the dialog
                If varResult <> False Then
                    ActiveWorkbook.SaveCopyAs Filename:=varResult '_
                    'FileFormat:=xlWorkbookNormal
                    ThisWorkbook.Saved = True
                    Exit Sub
                Else
                    ThisWorkbook.Saved = True
                End If

            ElseIf MsgBoxAnswer = vbNo Then

                ThisWorkbook.Saved = True

            ElseIf MsgBoxAnswer = vbCancel Then

                Cancel = True

            End If

        End If
    End If

End Sub


' Just in case the user presses save in options

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If InStr(UCase$(ThisWorkbook.Name), "BLANK") <> 0 Then
        If SaveAsUI = False Then
            MsgBox "This is the blank file. You can't save it. " _
              & "Please choose 'Save As' and save with a new file name.", _
              vbExclamation, "Can't Save Blank"
            Cancel = True
        End If
    End If
End Sub