Подтвердить что ты не робот

Сохранение нового документа Excel в виде книги без макросов без подсказки

Я использую 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

но не может заставить это работать. Кажется, что каждый пример этого использования находится внутри суб, который также обрабатывает сохранение документа, тогда как в моей ситуации SubSave заканчивается до того, как документ будет сохранен в стандартном, не-vba способе, который, возможно, почему он не работает?

Сбрасывает ли это свойство значение по умолчанию True после того, как sub закончил/до того, как на самом деле произойдет сохранение?

Извиняюсь за любую бессмыслицу, которую я, возможно, отказался, мой опыт работы с VBA очень ограничен.

4b9b3361

ОТВЕТЫ

Ответ 1

Я не могу тестировать 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

Попробуйте.

Ответ 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%\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

Ответ 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. Вызовите процедуру 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

Обратите внимание, что нам нужно установить переменную Cancel = True, чтобы предотвратить появление окна SaveAs по умолчанию. Кроме того, оператор if должен убедиться, что пользовательское окно SaveAs будет использоваться, только если файл не был сохранен.

Ответ 4

Чтобы ответить на ваши вопросы:

Возможно ли предотвратить появление этого сообщения?

Да, используя свойство Application.DisplayAlerts

Возможно ли, чтобы Excel предполагал, что пользователь хочет продолжить работу с книгой без макросов?

Нет, вам нужно написать процедуру, чтобы сохранить книгу и обойти событие SaveAs excel и сохранить книгу с использованием пользовательского ввода (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