Событие workbook_beforesave не запускается

У меня есть код VBA, который вынудил диалоговое окно сохранить как, чтобы при сохранении xltm показывать сохранение по умолчанию как тип как xlsm. Пожалуйста, проверьте прилагаемый код и исправьте меня, если код неправильный

Application.EnableEvents = False 
Application.DisplayAlerts = False 
If SaveAsUI = True Then 
    bInProcess = True 
'The following statements shows the save as dialog box with default path
    Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)
    FileSaveName.InitialFileName = ThisWorkbook.Name
    FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
    FileSaveName.Title = "Save As"
    intchoice = FileSaveName.Show
    If intchoice = 0 Then
    Else
        FileSaveName.Execute
    End If
Else 'Normal Save 
    bInProcess = True 
    Cancel = True
    ThisWorkbook.Save 
End If
Application.EnableEvents = True
Application.DisplayAlerts = True

Приведенный выше код прекрасно работает при попытке сохранить с помощью (Ctrl + S). Если бы я попытался закрыть через Excel закрыть окно. Excel показывает всплывающее окно сохранения по умолчанию. Если я выберу опцию "Сохранить" во всплывающем окне "Сохранить как", событие workbook_beforesave не вызывается (отображается диалоговое окно "Сохранить как" с типом данных по умолчанию, измененным на xls с xlsm). Я не знаю, какую ошибку я совершил? Пожалуйста, помогите мне избавиться от этого..

Заранее спасибо!!!

Источник

3 ответа

Вы должны поместить свой код между этими строками

Private Sub Workbook_BeforeClose(Cancel As Boolean)

End Sub
Источник

После перечитывания и еще одного тестирования я понимаю, что код в вашем вопросе уже находится в созданном вами событии Workbook_BeforeSave. Первый ответ, который вы получили, был в правильном направлении, вам нужно добавить дополнительный код в событие Workbook_BeforeClose для обработки правого верхнего X.

То, что вы хотите - это действительно сложная комбинация, которую очень сложно осуществить в Excel. Причина этого имеет несколько аспектов. Если вы закроете книгу с помощью правого верхнего X, это вызовет Workbook_BeforeClose, в этом случае ожидается закрытие документа. Если по какой-либо причине пользователь отменяет закрытие, это даст вам другое неожиданное состояние, при котором при повторном нажатии X Workbook_BeforeClose, кажется, не запускается снова, но теперь запускается Workbook_BeforeSave (встроенная версия).

Вот начало, которое поможет вам также реализовать сохранение xltm, но, как уже было сказано, оно будет ограничивать, поскольку вы заставляете пользователя либо сохранять рабочую книгу и выходить, либо не сохранять, но все же выходить из рабочей книги. Это немного грязно (goto label и т. Д.), Но вы меня поняли.

В Excel существует множество комбинаций "Закрыть / Сохранить", и трудно найти все правильные комбинации, так что вы можете решить использовать их совершенно по-другому...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

  If ActiveWorkbook.Saved = True Then
     Cancel = False
  Else

     Dim iReply As Byte, iType As Integer

     Dim events As Boolean
     Dim alerts As Boolean

     events = Application.EnableEvents
     alerts = Application.DisplayAlerts

     Application.EnableEvents = False
     Application.DisplayAlerts = False

  StartQuestion:

     ' Define buttons argument.
     iType = vbYesNo + vbQuestion + vbDefaultButton2
     iReply = MsgBox("Would you like to save now?", iType)

     Select Case iReply
       Case Is = vbYes         ' user chose Yes save current workbook

         'The following statements shows the save as dialog box with default path
         Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)

         FileSaveName.InitialFileName = ThisWorkbook.Name
         FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
         FileSaveName.Title = "Save As ... "

         intchoice = FileSaveName.Show

         If intchoice = 0 Then
         Else
            FileSaveName.Execute
         End If

         If ActiveWorkbook.Saved = True Then
            ActiveWorkbook.Close
            Cancel = False
         Else
            GoTo StartQuestion
         End If

      Case Is = vbNo           ' user chose No, don't save

        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close
        Cancel = False

     End Select

     Application.EnableEvents = events
     Application.DisplayAlerts = alerts

   End If

End Sub
Источник

Спасибо всем за вашу помощь. Я разобрался с решением.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

StartQuestion:
Cancel = True
'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
     Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
         vbYesNoCancel + vbExclamation)
         Case Is = vbYes
             Call CustomSave(vbYes)
             If cancelclicked = False Then
                ThisWorkbook.Saved = True
             Else
                GoTo StartQuestion
             End If
         Case Is = vbNo
             ThisWorkbook.Saved = True
         Case Is = vbCancel
             Exit Sub
     End Select
End With
Cancel = False
End Sub

Sub CustomSave(ans As Long)
Dim MinExtensionX
Dim Arr() As Variant
Dim lngLoc As Variant
Dim events As Boolean
Dim alerts As Boolean
If ActiveWorkbook.Saved = True Then
     Cancel = False
Else
     events = Application.EnableEvents
     alerts = Application.DisplayAlerts

     Application.EnableEvents = False
     Application.DisplayAlerts = False

StartQuestion:
    Select Case ans
    Case Is = vbYes         ' user chose Yes save current workbook
        MinExtensionX = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") + 1)
        Arr = Array("xlsx", "xlsm", "xlsb", "xls", "xml", "mht", "mhtml", "htm", "html", "xltx", "xltm", "xlt", "txt", "csv", "prn", "dif", "slk", "xlam", "xla", "pdf", "xps", "ods") 'define which extensions you want to allow
        On Error Resume Next
        lngLoc = Application.WorksheetFunction.Match(MinExtensionX, Arr(), 0)
        If IsEmpty(lngLoc) Then '
            'The following statements shows the save as dialog box with default path
             Set FileSaveName = Application.FileDialog(msoFileDialogSaveAs)

             FileSaveName.InitialFileName = ThisWorkbook.Name
             FileSaveName.FilterIndex = 2   'select to save with a ".xlsm" extension
             FileSaveName.Title = "Save As ... "

             intchoice = FileSaveName.Show
             If intchoice = 0 Then
                cancelclicked = True
             Else
                FileSaveName.Execute
             End If
        Else
            ThisWorkbook.Save
        End If
 End Select
 End If
 End Sub
Источник
Другие вопросы по тегам