vba 在没有提示的情况下将新 Excel 文档保存为无宏工作簿

Saving new Excel document as macro-free workbook without prompt

提问by Tom Turner

I'm using Excel 2010. I have an Excel macro-enabled template that has a data connection to a text file that is set to automatically refresh when a new document is created using this template.

我使用的是 Excel 2010。我有一个 Excel 启用宏的模板，该模板具有到文本文件的数据连接，该文本文件设置为在使用此模板创建新文档时自动刷新。

The following macro is within the "ThisWorkbook" object to remove the data connection before saving the new document:

以下宏位于“ThisWorkbook”对象中，用于在保存新文档之前删除数据连接：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Do While ActiveWorkbook.Connections.Count > 0
        ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete
    Loop

End Sub

When a user clicks the save icon / hits ctrl+S, inputs a filename and then clicks save to save as a macro-free Excel workbook (as is the default and required filetype) they are prompted with a message stating:

当用户单击保存图标/按 ctrl+S，输入文件名，然后单击保存以另存为无宏 Excel 工作簿（这是默认和必需的文件类型）时，系统会提示他们一条消息：

The following features cannot be saved in macro-free workbooks:

? VB project

To save a file with these features, click No, and then choose a macro-enabled file type in the File Type list.

To continue saving as a macro-free workbook, click Yes.

以下功能无法保存在无宏工作簿中：

? VB项目

要使用这些功能保存文件，请单击否，然后在文件类型列表中选择启用宏的文件类型。

要继续保存为无宏工作簿，请单击是。

Is it possible to prevent this message from appearing and have Excel assume that the user wants to continue with a macro-free workbook?

是否可以防止出现此消息并让 Excel 假定用户想要继续使用无宏工作簿？

I've searched all over and understand that I may be able to add code to the workbook object that removes itself so that Excel has no VB project to cause this message but this would require each user to change Trust Center Settings (Trust access to the VBA project object model) which I want to avoid.

我已经到处搜索并了解到我可以将代码添加到删除自身的工作簿对象中，以便 Excel 没有 VB 项目导致此消息，但这将要求每个用户更改信任中心设置（信任访问VBA 项目对象模型），我想避免。

I've also seen suggestions of using:

我还看到了使用的建议：

Application.DisplayAlerts = False

but can't get this to work. Every example of it's use seems to be within a sub that is also handling the saving of the document whereas in my situation the BeforeSave sub ends before the document is saved in the default, non-vba way which is perhaps why it does not work?

但无法让它发挥作用。它使用的每个示例似乎都在一个也在处理文档保存的子程序中，而在我的情况下， BeforeSave 子程序在以默认的非 vba 方式保存文档之前结束，这也许是它不起作用的原因？

Does this property reset to a default True after the sub has ended / before the save actually occurs?

在 sub 结束后/在实际保存之前，此属性是否重置为默认值 True？

Apologies for any nonsense I may have dispensed, my experience with VBA is very limited.

对于我可能已经免除的任何废话，我深表歉意，我对 VBA 的经验非常有限。

回答by EarlyBird2

I cannot test on Excel 2010, but at least for 2016, it's working fine:

我无法在 Excel 2010 上进行测试，但至少在 2016 年，它运行良好：

Sub SaveAsRegularWorkbook()

    Dim wb As Workbook
    Dim Path As String

    Set wb = ThisWorkbook
    Path = "T:\he\Path\you\prefer\"
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
    Application.DisplayAlerts = True
    Application.EnableEvents = True

End Sub

Give it a try.

试一试。

回答by Cyril

Different approach... when the template is loaded, require the user to save as (I have a workbook/template with a similar situation...). This should open them up to the user's Documents folder, though you can adjust to save to whatever location.

不同的方法......加载模板时，要求用户另存为（我有一个类似情况的工作簿/模板......）。这应该将它们打开到用户的 Documents 文件夹，但您可以调整以保存到任何位置。

Inside of the ThisWorkbook module, put:

在 ThisWorkbook 模块中，放置：

Option Explicit

Private Sub Workbook_Open()
    Dim loc As Variant
    Application.DisplayAlerts = False
    loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\NAME_OF_FILE")
    If loc <> False Then
        ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
        Exit Sub
    End If
    Application.DisplayAlerts = True
End Sub

---

---

Edit1: Adding the if statement using a base-template name, so subsequent saves do not prompt the save-as:

Edit1：使用基本模板名称添加if语句，因此后续保存不会提示另存为：

Option Explicit

Private Sub Workbook_Open()
    If ActiveWorkbook.Name = "_NAME_OF_FILE.xlsb" Then
        Dim loc As Variant
        Application.DisplayAlerts = False 
        loc = Application.GetSaveAsFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As...", InitialFileName:="%USERPROFILE%\Documents\_NAME_OF_FILE")
        If loc <> False Then
            ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
            Exit Sub
        End If
        Application.DisplayAlerts = True
    End If
End Sub

回答by DecimalTurn

For this answer, I'm assuming that by Excel macro-enabled template, you mean a xltm file. I also guess that what you mean by "new document" is the document that is generated when a user double-clicks on the xtlm file (hence this new file has no location on since it hasn't been saved yet).

对于这个答案，我假设通过 Excel 启用宏的模板，您的意思是一个 xltm 文件。我也猜你所说的“新文档”是指用户双击 xtlm 文件时生成的文档（因此这个新文件没有位置，因为它还没有保存）。

To solve your issue, you could use a custom SaveAs window(Application.GetSaveAsFilename) to have more control on how the user saves the file when the Workbook_BeforeSaveevent macro gets called.

要解决您的问题，您可以使用自定义 SaveAs 窗口( Application.GetSaveAsFilename) 来更好地控制用户Workbook_BeforeSave在调用事件宏时如何保存文件。

Here is how to implement it:

以下是实现它的方法：

1- Copy this code into a new module.

1- 将此代码复制到新模块中。

Option Explicit  

Sub SaveAsCustomWindow()  

    Const C_PROC_NAME As String = "SaveAsCustomWindow"
    Dim strFullFileName As String, strPreferedFolder As String, strDefaultName As String
    Dim UserInput1 As Variant, UserInput2 As Variant
    Dim isValidName As Boolean, isFileClosed As Boolean, isWorkbookClosed As Boolean
    Dim strFilename As String, strFilePath As String


    'To avoid Warning when overwriting
    Application.DisplayAlerts = False
    'Disable events (mostly for the BeforeSave event) to avoid creating infinite loop
    Application.EnableEvents = False
    On Error GoTo ErrHandler

    'Customizable section
    strDefaultName = ThisWorkbook.Name
    strPreferedFolder = Environ("USERPROFILE")

    Do While isWorkbookClosed = False
        Do While isFileClosed = False
            Do While isValidName = False
                UserInput1 = Application.GetSaveAsFilename(InitialFileName:=strPreferedFolder & "\" & strDefaultName, FileFilter:="Excel Workbook (*.xlsx),*.xlsx")

                If UserInput1 = False Then
                    GoTo ClosingStatements 'This is important to take care of the case when the user presses cancel
                Else
                    strFullFileName = UserInput1
                End If

                strFilename = Right(strFullFileName, Len(strFullFileName) - InStrRev(strFullFileName, "\"))
                strDefaultName = strFilename

                strFilePath = Left(strFullFileName, InStrRev(strFullFileName, "\") - 1)
                strPreferedFolder = strFilePath

                'If the file exist, ask for overwrite permission
                If Dir(strFullFileName) <> "" Then
                    UserInput2 = MsgBox(strFilename & " already exists." & vbNewLine & "Do you want to overwrite?", vbYesNoCancel Or vbExclamation)
                    If UserInput2 = vbNo Then
                        isValidName = False
                    ElseIf UserInput2 = vbYes Then
                        isValidName = True
                    ElseIf UserInput2 = vbCancel Then
                        GoTo ClosingStatements
                    Else
                        GoTo ClosingStatements
                    End If
                Else
                    isValidName = True
                End If
            Loop

            'Check if file is actually open
            If isFileOpen(strFullFileName) Then
                MsgBox "The workbook you want to overwrite is currently open. Choose a different name, or close the  workbook before saving.", vbExclamation
                isValidName = False
                isFileClosed = False
            Else
                isFileClosed = True
            End If
        Loop

        'Check if an opened workbook has the same name
        If isWorkbookOpen(strFilename) Then
            MsgBox "You cannot save this workbook with the same name as another open workbook or add-in. Choose a different name, or close the other workbook or add-in before saving.", vbExclamation
            isValidName = False
            isFileClosed = False
            isWorkbookClosed = False
        Else
            isWorkbookClosed = True
        End If
    Loop

    ThisWorkbook.SaveAs Filename:=strFullFileName, FileFormat:=xlOpenXMLWorkbook

ClosingStatements:
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Exit Sub
ErrHandler:
    Call MsgBox("Run-time error '" & Err.Number & "': " & Err.Description & vbNewLine & _
         "While running: " & C_PROC_NAME & IIf(Erl <> 0, vbNewLine & "Error Line: " & Erl, "")
    GoTo ClosingStatements

End Sub

Function isFileOpen(ByVal Filename As String) As Boolean

    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open Filename For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:    isFileOpen = False
        Case 70:   isFileOpen = True
    End Select

End Function

Function isWorkbookOpen(ByVal Filename As String) As Boolean

    Dim wb As Workbook, ErrNo As Long

    On Error Resume Next
    Set wb = Workbooks(Filename)
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
        Case 0:         isWorkbookOpen = True
        Case Else:      isWorkbookOpen = False
    End Select

End Function

Explanation of part 1: This whole thing might seem a bit overkill, but all the error handling is important here to take into account potential errors and make sure that the setting for Application.EnableEventsis turned back to TRUEeven if an error occurs. Otherwise, all event macros will be disabled in your Excel application.

第 1 部分的解释：整个事情可能看起来有点矫枉过正，但这里的所有错误处理都很重要，以考虑到潜在的错误，并确保即使发生错误也能将 的设置Application.EnableEvents转回TRUE。否则，Excel 应用程序中的所有事件宏都将被禁用。

2- Call the SaveAsCustomWindowprocedure inside the Workbook_BeforeSave event procedure like this:

2-SaveAsCustomWindow像这样调用Workbook_BeforeSave 事件过程中的过程：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    'Your code

    If ThisWorkbook.Path = "" Then
        SaveAsCustomWindow
        Cancel = True
    End If

End Sub

Note that we need to set the variable Cancel = Truein order to prevent the default SaveAs window to show up. Also, the if statement is there to make sure that the custom SaveAs window will only be used if the file has neverbeen saved.

请注意，我们需要设置变量Cancel = True以防止显示默认的 SaveAs 窗口。此外，if 语句用于确保自定义 SaveAs 窗口仅在从未保存过文件时使用。

回答by EEM

To answer your questions:

回答您的问题：

Is it possible to prevent this message from appearing?

是否可以防止出现此消息？

Yes, using the Application.DisplayAlertsproperty

是的，使用该Application.DisplayAlerts物业

Is it possible to have Excel assume that the user wants to continue with a macro-free workbook?

是否可以让 Excel 假设用户想要继续使用无宏工作簿？

No, you have to write the procedure to save the workbook and bypass the SaveAsexcel event and save the workbook using the user input (Path& Filename) with the required format.

不，您必须编写程序来保存工作簿并绕过SaveAsexcel 事件并使用用户输入 ( Path& Filename) 以所需格式保存工作簿。

The following procedure uses a FileDialog to capture the Path and Filename from the user then saves the file without displaying the warning message. I have added some explanatory comments nevertheless, let me know of any questions you might have.

以下过程使用 FileDialog 从用户捕获路径和文件名，然后保存文件而不显示警告消息。尽管如此，我还是添加了一些解释性评论，如果您有任何问题，请告诉我。

Copy these procedures in the ThisWorkbookmodule:

在ThisWorkbook模块中复制这些过程：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = True       'Prevents repetitive Save
    Call Workbook_BeforeSave_ApplySettings_And_Save
    End Sub


Private Sub Workbook_BeforeSave_ApplySettings_And_Save()
Dim fd As FileDialog, sFilename As String

    Rem Sets FileDialog to capture user input
    Set fd = Application.FileDialog(msoFileDialogSaveAs)
    With fd
        .InitialView = msoFileDialogViewDetails
        .Title = vbNullString               'Resets default value in case it was changed
        .ButtonName = vbNullString          'Resets default value in case it was changed
        .AllowMultiSelect = False
        If .Show = 0 Then Exit Sub          'User pressed the Cancel Button
        sFilename = .SelectedItems(1)
    End With

    With ThisWorkbook

        Do While .Connections.Count > 0
            .Connections.Item(.Connections.Count).Delete
        Loop

        Application.EnableEvents = False                                'Prevents repetition of the Workbook_BeforeSave event
        Application.DisplayAlerts = False                               'Prevents Display of the warning message
        On Error Resume Next                                            'Prevents Events and Display staying disable in case of error
        .SaveAs Filename:=sFilename, FileFormat:=xlOpenXMLWorkbook      'Saves Template as standard excel using user input
        If Err.Number <> 0 Then
            MsgBox "Run-time error " & Err.Number & String(2, vbLf) _
                & Err.Description & String(2, vbLf) _
                & vbTab & "Process will be cancelled.", _
                vbOKOnly, "Microsoft Visual Basic"
        End If
        On Error GoTo 0
        Application.DisplayAlerts = True
        Application.EnableEvents = True

    End With

    End Sub