Excel VBA - 另存为对话框窗口 - 如果按下"cancel"停止代码继续?



我目前使用以下代码强制用户将文件另存为启用宏的工作簿。

Application.Dialogs(xlDialogSaveAs).Show , xlOpenXMLWorkbookMacroEnabled

问题是,如果用户按下"取消"按钮,代码将继续。如果按下"取消"按钮,我需要停止它。

任何帮助,不胜感激。

谢谢。

单击

取消按钮时,您必须捕获事件。

Sub saveasxml()
Dim userResponce As Boolean
On Error Resume Next
 userResponce = Application.Dialogs(xlDialogSaveAs).Show("Test name", 52)
On Error GoTo 0
If userResponce = False Then
    MsgBox "Cancel clicked"
    Exit Sub
Else
    MsgBox "You saved file "
End If
End Sub

这个页面有一个很好的例子,解释了你需要做什么:

http://codevba.com/excel/dialogs.htm#SaveAs

本质上,它是这样的:

' Application.Dialogs(xlDialogSaveAs).Show returns
' True or False depending on whether the user canceled or not
If Application.Dialogs(xlDialogSaveAs).Show Then
   ' User saved
Else
   ' User canceled
End If

从上面的链接中获取一个更完整的示例,并根据您的目的对其进行稍微修改:

Sub thing()
Dim strFilename As String: strFilename = "report1"
Dim strFolder As String: strFolder = "C:temp" 'initial directory - NOTE: Only works if file has not yet been saved!
'Dim xlfFileFormat As XlFileFormat: xlfFileFormat = XlFileFormat.xlOpenXMLWorkbook 'or replace by other XlFileFormat
Dim xlfFileFormat As XlFileFormat: xlfFileFormat = XlFileFormat.xlOpenXMLWorkbookMacroEnabled 'or replace by other XlFileFormat
Dim strPassword As String: 'strPassword = "password" 'The password with which to protect the file - if any
Dim booBackup As Boolean: 'booBackup = True  '(Whether to create a backup of the file.)
Dim strWriteReservationPassword As String: 'strWriteReservationPassword = "password2" ' (The write-reservation password of the file.)
Dim booReadOnlyRecommendation As Boolean: booReadOnlyRecommendation = False '(Whether to recommend to the user that the file be opened in read-only mode.)
Dim booWorkbookSaved As Boolean ' true if file saved, false if dialog canceled
If Len(strFolder) > 0 Then ChDir strFolder
booWorkbookSaved = Application.Dialogs(xlDialogSaveAs).Show(Arg1:=strFilename, Arg2:=xlfFileFormat, Arg3:=strPassword, _
                                            Arg4:=booBackup, Arg5:=strWriteReservationPassword, Arg6:=booReadOnlyRecommendation)
If Not booWorkbookSaved Then
    Exit Sub
End If
MsgBox "Workbook saved"
End Sub

最新更新