2016-01-24 181 views
0

我有一個VBA代碼,它強制另存爲對話框,在嘗試保存xltm時顯示默認保存類型爲xlsm。請檢查連接的代碼,並糾正我,如果代碼是不正確workbook_beforesave event not firing

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事件(另存爲對話框顯示,默認數據類型已更改爲xlsm中的xls)。我不知道我犯了什麼錯誤?請幫我擺脫這個..

在此先感謝!

+0

希望以下私人小組Workbook_BeforeClose(取消正如布爾) – Linga

+0

感謝您即時reply.sorry你的代碼,我做的標題是錯誤的。它在workbook_beforeSave事件 – Maya

+0

希望現在你明白了:) – Linga

回答

0

您需要將重新閱讀和一些更多的測試我明白你的問題的代碼已經在您創建的Workbook_BeforeSave事件之後,這些線路

Private Sub Workbook_BeforeClose(Cancel As Boolean) 

End Sub 
+0

Excel在關閉時不顯示默認彈出窗口,而不是保存工作簿。我無法強制用戶在關閉時保存工作簿 – Maya

0

之間的代碼。你得到的第一個答案實際上是正確的,你需要在Workbook_BeforeClose事件中添加額外的代碼來處理右上角的X.

你想要的是一個非常棘手的組合,很難在Excel中完成。其原因有幾個方面。如果使用右上角的X關閉工作簿,這將觸發Workbook_BeforeClose,那麼該文檔預計將在該事件中關閉。如果由於某種原因用戶取消了關閉,這會再次出現意外狀態,當再次按下X時,Workbook_BeforeClose似乎不會再次觸發,但現在觸發了Workbook_BeforeSave(內置版本)。

這裏是開始讓你在實現xltm保存的同時,如上所述,它會限制你強制用戶保存工作簿並退出或不保存但仍然退出工作簿。這有點髒(轉到標籤等),但你得到我的漂移。

有在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 
+0

Thanks.Above代碼正常工作。「ThisWorkbook.Close」語句關閉工作簿,但可以看到空白屏幕。我不想顯示那個空白的excel(一個灰色區域的屏幕)。我不能關閉應用程序。如果兩個excel區域打開,它會關閉其他excel。任何想法來解決這個問題? – Maya

+0

此外,如果打開兩個工作簿,在保存彈出窗口中選擇no會導致excel – Maya

+0

崩潰,我不希望每次都顯示另存爲對話框。如果文件已保存一個,它將保存更改,而不顯示彈出窗口 – Maya

0

感謝所有您的幫助。我想出瞭解決方案。

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