将新的Excel文档保存为无宏工作簿而不提示-Java 学习之路

我正在使用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的经验非常有限 .

4 回答

我无法在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

试试看 .

回复于 2024-05-03T13:28:28+08:00

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

在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：使用基本模板名称添加if语句，因此后续保存不会提示save-as：

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

回复于 2024-05-03T13:28:28+08:00

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

要解决您的问题，您可以使用 custom SaveAs window （ 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

Explanation of part 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窗口 .

回复于 2024-05-03T13:28:28+08:00

回答你的问题：

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

是的，使用 Application.DisplayAlerts 属性

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

不，您必须编写保存工作簿的过程并绕过 SaveAs excel事件并使用具有所需格式的用户输入（ Path ＆ Filename ）保存工作簿 .

以下过程使用FileDialog从用户捕获Path和Filename，然后保存文件而不显示警告消息 . 不过我已经添加了一些解释性意见，请告诉我您可能遇到的任何问题 .

在 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

回复于 2024-05-03T13:28:28+08:00

将新的Excel文档保存为无宏工作簿而不提示

4 回答

相关问题