使用RED X关闭工作簿并禁用“保存”提示并默认选中“不保存”

时间:2013-10-02 16:03:56

标签: excel vba

好的,我正在处理的工作簿应该阻止USERLIST关闭它而不允许它首先更新另一个工作簿然后保存。我试图避免添加一个按钮来执行此操作,并在用户单击RED X关闭窗口时发生这种情况。但是,在某些情况下,其他非用户会访问它并且无法更新它。我想给他们选择退出而不更新和保存,但我不知道如何禁用“你想保存”对话框,默认设置为“不保存”。如果我使用代码

Application.DisplayAlerts = False
ActiveWorkbook.Close False

它重新启动整个过程并循环它。有没有办法避免这种情况?请原谅我从以前的问题中收集的基本编码,我正在学习这一切。

Private Sub Workbook_BeforeClose(Cancel As Boolean)

**Response = MsgBox(prompt:="Are you sure you are ready to close for the day?", Buttons:=vbYesNo)
If Response = vbYes Then**
    SWEEPER = ThisWorkbook.Worksheets("SET").Cells(1, Columns.Count).End(xlToLeft).Column
    USER = Environ("username")

        For i = 1 To SWEEPER
            ThisWorkbook.Worksheets("SET").Activate
            ThisWorkbook.Worksheets("SET").Cells(1, i).Select

            If ThisWorkbook.Worksheets("SET").Cells(1, i).Value = USER Then
                Set DATES = Workbooks.Open _
                    ("test.xlsx")
                ActiveWorkbook.Worksheets("DATES").Activate
                Call Date_Updates

            Exit Sub

            End If

        Next i
    **Else
    'Cancel = True
    'MsgBox "Master Not Updated."
    Response = MsgBox(prompt:="Are you trying to close without saving and updating?", Buttons:=vbYesNo)
        If Response = vbYes Then
        Application.DisplayAlerts = False
        'ActiveWorkbook.Close False
        Exit Sub
        Else
        Cancel = True
        MsgBox "Master Not Updated."
        End If
    Exit Sub**
End If
MsgBox "You are not authorized to edit this document."

End Sub

Sub Date_Updates()

USER = Environ("username")

SWEEPER = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To SWEEPER
ActiveWorkbook.Worksheets("DATES").Cells(1, i).Select
STATE = ThisWorkbook.Worksheets("SET").Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row

If ThisWorkbook.Worksheets("SET").Cells(1, i).Value = USER Then
    For l = 2 To STATE
        ActiveWorkbook.Worksheets("DATES").Cells(l, ActiveCell.Column).Activate
        STName = ThisWorkbook.Worksheets("SET").Cells(l, ActiveCell.Column).Value



        CHECKED = ThisWorkbook.Worksheets(STName).Range("R4")
        RESULT = ThisWorkbook.Worksheets(STName).Range("S4")

            If ThisWorkbook.Worksheets(STName).Range("R4") And ThisWorkbook.Worksheets(STName).Range("S4") > "" Then
                ActiveWorkbook.Worksheets("DATES").Range("F2:I27").Find(What:=STName, After:=Range("I27"), _
                    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False).Activate
                ActiveCell.Next.Activate
                ActiveCell = CHECKED
                ActiveCell.Next.Activate
                ActiveCell = RESULT
                ActiveWorkbook.Worksheets("DATES").Range("A2:C21").Find(What:=STName, After:=Range("C21"), _
                    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, MatchCase:=False).Activate
            End If

    Next l
    MsgBox "Update Complete"
    DATES.Save
    DATES.Close
    ThisWorkbook.Save
    Exit Sub
End If


Next i
End Sub

1 个答案:

答案 0 :(得分:1)

我再次相信我已经回答了我自己的问题:如何在Excel中关闭工作簿时禁止“保存更改”提示

示例1:关闭工作簿而不保存更改

要在不保存任何更改的情况下强制关闭工作簿,请在该工作簿的Visual Basic模块中键入以下代码:

Sub Auto_Close()
ThisWorkbook.Saved = True
End Sub

我的代码:

ElseIf response = vbCancel Then
    response = MsgBox(prompt:="Master not updated. Are you trying to close without saving and updating?", Buttons:=vbYesNo)
        If response = vbYes Then
        ActiveWorkbook.Saved = True
        Exit Sub