Сохранить как xlsx, затем закрыть, не закрывая все книги - PullRequest
0 голосов
/ 01 мая 2019

Я хочу сохранить активную книгу как xlsx, а затем закрыть ее, не закрывая все открытые книги Excel. Этот код работает, но закрывает все открытые файлы Excel.

Если я удаляю Application.Quit и оставляю ThisWorkbook.Close, это будет работать только в том случае, если у меня открыто более одной рабочей книги, но если у меня будет открыта только одна рабочая книга, она закроется, но оставит открытым пустое окно Excel.

Sub SaveAsXlsx()

Dim varResponse As Variant
varResponse = MsgBox("Save As xlsx Removing Macros & Then Closes The Workbook", vbYesNo, "Save As xlsx")
If varResponse <> vbYes Then Exit Sub

Application.DisplayAlerts = False
Dim FilePath As String
FilePath = ThisWorkbook.FullName
FilePath = Left(FilePath, Len(FilePath) - 5) & " To Review" & ".xlsx"

ThisWorkbook.SaveAs Filename:=FilePath, FileFormat:= _
    xlOpenXMLWorkbook, CreateBackup:=False

'Enter Anything to Happen on xlsx Book Here
Range("A1").Select


ThisWorkbook.Save

FilePath = Application.ActiveWorkbook.FullName
MsgBox "Saved Review Copy As" & Chr(10) & Chr(10) & FilePath, , "Saved!"

Application.Quit
ThisWorkbook.Close


End Sub

1 Ответ

0 голосов
/ 01 мая 2019

Чтобы закрыть Excel, если ваш код закрывает последнюю открытую книгу, но оставьте ее открытой, если есть другие открытые книги, вам нужно проверить свойство Application.Workbook.Count, например:

Sub SaveAsXlsx()

  Dim varResponse As Variant
  varResponse = MsgBox("Save As xlsx Removing Macros & Then Closes The Workbook", vbYesNo, "Save As xlsx")
  If varResponse <> vbYes Then Exit Sub

  Application.DisplayAlerts = False
  Dim FilePath As String
  FilePath = ThisWorkbook.FullName
  FilePath = Left(FilePath, Len(FilePath) - 5) & " To Review" & ".xlsx"

  ThisWorkbook.SaveAs Filename:=FilePath, FileFormat:= _
                      xlOpenXMLWorkbook, CreateBackup:=False

'Enter Anything to Happen on xlsx Book Here
  Range("A1").Select


  ThisWorkbook.Save

  FilePath = Application.ActiveWorkbook.FullName
  MsgBox "Saved Review Copy As" & Chr(10) & Chr(10) & FilePath, , "Saved!"

  ThisWorkbook.Close

  If Excel.Application.Workbooks.Count = 0 Then
    Application.Quit
  End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...