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

Question

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

以下宏位于"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

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

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

• VB项目

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

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

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

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

我还看到了使用的建议：

Application.DisplayAlerts = False

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

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

对于我可能免除的任何废话，我使用VBA的经验非常有限。

Answer 1

> 我无法在 Excel 2010 上进行测试，但至少在 2016 年，它工作正常：

Sub SaveAsRegularWorkbook()
Dim wb As Workbook
Dim Path As String
Set wb = ThisWorkbook
Path = "T:hePathyouprefer"
Application.DisplayAlerts = False
Application.EnableEvents = False
wb.SaveAs Filename:=Path & "Test.xlsx", FileFormat:=51
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

试一试。

Answer 2

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

在 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%DocumentsNAME_OF_FILE")
If loc <> False Then
ActiveWorkbook.SaveAs Filename:=loc, FileFormat:=51
Exit Sub
End If
Application.DisplayAlerts = True
End Sub

---

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

Answer 3

对于这个答案，我假设 Excel 宏启用模板是指 xltm 文件。我还猜测，您所说的"新文档"是指用户双击 xtlm 文件时生成的文档(因此这个新文件没有位置，因为它尚未保存(。

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

以下是实现它的方法：

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

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

2- 在Workbook_BeforeSave事件过程中调用SaveAsCustomWindow过程，如下所示：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Your code
If ThisWorkbook.Path = "" Then
SaveAsCustomWindow
Cancel = True
End If
End Sub

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

Answer 4

要回答您的问题：

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

是，使用Application.DisplayAlerts属性

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

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

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

在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