Как использовать VBA SaveAs без закрытия рабочей книги?

Я хочу:

Обработать данные с помощью рабочей книги Template
Сохраните копию этой рабочей книги как .xlsx(SaveCopyAs не позволяет изменять типы файлов, иначе это было бы здорово)
Продолжить показ оригинального шаблона (а не "сохраненного как" )

Использование SaveAs делает именно то, что ожидается - это экономит рабочую книгу при удалении макросов и представляет мне представление о недавно созданной книге SavedAs.

К сожалению, это означает:

Я больше не просматриваю свою рабочую книгу с включенным макросом, если я не открываю ее повторно
Выполнение кода останавливается в этот момент, потому что
Любые изменения макросов отбрасываются, если я забыл сохранить (примечание: для производственной среды это нормально, но для развития это огромная боль)

Есть ли способ сделать это?

'current code
Application.DisplayAlerts = False
templateWb.SaveAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
templateWb.Activate
Application.DisplayAlerts = True

'I don't really want to make something like this work (this fails, anyways)
Dim myTempStr As String
myTempStr = ThisWorkbook.Path & "\" & ThisWorkbook.Name
ThisWorkbook.Save
templateWb.SaveAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Workbooks.Open (myTempStr)

'I want to do something like:
templateWb.SaveCopyAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'SaveCopyAs only takes one argument, that being FileName

Также обратите внимание, что в то время как SaveCopyAs позволит мне сохранить его как другой тип (т.е. templateWb.SaveCopyAs FileName:="myXlsx.xlsx"), это приводит к ошибке при его открытии, поскольку теперь он имеет недопустимый формат файла.

Ответ 1

Я сделал что-то похожее на то, что предложил Сиддхарт, и написал функцию, чтобы сделать это, а также справиться с некоторыми неприятностями и предложить еще большую гибкость.

Sub saveExample()
    Application.ScreenUpdating = False

    mySaveCopyAs ThisWorkbook, "C:\Temp\testfile2", xlOpenXMLWorkbook

    Application.ScreenUpdating = True
End Sub

Private Function mySaveCopyAs(pWorkbookToBeSaved As Workbook, pNewFileName As String, pFileFormat As XlFileFormat) As Boolean

    'returns false on errors
    On Error GoTo errHandler



     If pFileFormat = xlOpenXMLWorkbookMacroEnabled Then
        'no macros can be saved on this
        mySaveCopyAs = False
        Exit Function
    End If

    'create new workbook
    Dim mSaveWorkbook As Workbook
    Set mSaveWorkbook = Workbooks.Add

    Dim initialSheets As Integer
    initialSheets = mSaveWorkbook.Sheets.Count


    'note: sheet names will be 'Sheet1 (2)' in copy otherwise if
    'they are not renamed
    Dim sheetNames() As String
    Dim activeSheetIndex As Integer
    activeSheetIndex = pWorkbookToBeSaved.ActiveSheet.Index

    Dim i As Integer
    'copy each sheet
    For i = 1 To pWorkbookToBeSaved.Sheets.Count
        pWorkbookToBeSaved.Sheets(i).Copy After:=mSaveWorkbook.Sheets(mSaveWorkbook.Sheets.Count)
        ReDim Preserve sheetNames(1 To i) As String
        sheetNames(i) = pWorkbookToBeSaved.Sheets(i).Name
    Next i

    'clear sheets from new workbook
    Application.DisplayAlerts = False
    For i = 1 To initialSheets
        mSaveWorkbook.Sheets(1).Delete
    Next i

    'rename stuff
    For i = 1 To UBound(sheetNames)
        mSaveWorkbook.Sheets(i).Name = sheetNames(i)
    Next i

    'reset view
    mSaveWorkbook.Sheets(activeSheetIndex).Activate

    'save and close
    mSaveWorkbook.SaveAs FileName:=pNewFileName, FileFormat:=pFileFormat, CreateBackup:=False
    mSaveWorkbook.Close
    mySaveCopyAs = True

    Application.DisplayAlerts = True
    Exit Function

errHandler:
    'whatever else you want to do with error handling
    mySaveCopyAs = False
    Exit Function


End Function

Ответ 2

Вот гораздо более быстрый метод, чем использование .SaveCopyAs для создания копии, затем откройте эту копию и сделайте сохранение как...

Как уже упоминалось в моих комментариях, этот процесс занимает около 1 секунды, чтобы создать копию xlsx из книги, содержащей 10 листов (каждый со 100 строками * 20 полных данных)

Sub Sample()
    Dim thisWb As Workbook, wbTemp As Workbook
    Dim ws As Worksheet

    On Error GoTo Whoa

    Application.DisplayAlerts = False

    Set thisWb = ThisWorkbook
    Set wbTemp = Workbooks.Add

    On Error Resume Next
    For Each ws In wbTemp.Worksheets
        ws.Delete
    Next
    On Error GoTo 0

    For Each ws In thisWb.Sheets
        ws.Copy After:=wbTemp.Sheets(1)
    Next

    wbTemp.Sheets(1).Delete
    wbTemp.SaveAs "C:\Blah Blah.xlsx", 51

LetsContinue:
    Application.DisplayAlerts = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Ответ 3

В Excel VBA нет ничего симпатичного или приятного в этом процессе, но что-то вроде ниже. Этот код плохо обрабатывает ошибки, уродлив, но должен работать.

Мы копируем книгу, открываем и сохраняем копию, а затем удаляем копию. Временная копия хранится в вашем локальном каталоге temp и удаляется также там.

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" _
         Alias "GetTempPathA" (ByVal nBufferLength As Long, _
         ByVal lpBuffer As String) As Long

Public Sub SaveCopyAs(TargetBook As Workbook, Filename, FileFormat, CreateBackup)
  Dim sTempPath As String * 512
  Dim lPathLength As Long
  Dim sFileName As String
  Dim TempBook As Workbook
  Dim bOldDisplayAlerts As Boolean
  bOldDisplayAlerts = Application.DisplayAlerts
  Application.DisplayAlerts = False

  lPathLength = GetTempPath(512, sTempPath)
  sFileName = Left$(sTempPath, lPathLength) & "tempDelete_" & TargetBook.Name

  TargetBook.SaveCopyAs sFileName

  Set TempBook = Application.Workbooks.Open(sFileName)
  TempBook.SaveAs Filename, FileFormat, CreateBackup:=CreateBackup
  TempBook.Close False

  Kill sFileName
  Application.DisplayAlerts = bOldDisplayAlerts
End Sub

Ответ 4

У меня есть аналогичный процесс, вот решение, которое я использую. Он позволяет пользователю открывать шаблон, выполнять манипуляции, сохранять шаблон где-нибудь, а затем открывать исходный шаблон

пользователь открывает файл с поддержкой макроса
делать манипуляции
сохранить путь к файлу ActiveWorkbook (файл шаблона)
выполнить SaveAs
установите ActiveWorkbook (теперь файл saveas) как переменную
открыть путь к файлу шаблона на шаге 3
закрыть переменную на шаге 5

код выглядит примерно так:

    'stores file path of activeworkbook BEFORE the SaveAs is executed
    getExprterFilePath = Application.ActiveWorkbook.FullName

    'executes a SaveAs
    ActiveWorkbook.SaveAs Filename:=filepathHere, _
    FileFormat:=51, _
    Password:="", _
    WriteResPassword:="", _
    ReadOnlyRecommended:=False, _
    CreateBackup:=False

    'reenables alerts
    Application.DisplayAlerts = True


    'announces completion to user
    MsgBox "Export Complete", vbOKOnly, "List Exporter"             


    'sets open file (newly created file) as variable
    Set wbBLE = ActiveWorkbook

    'opens original template file
    Workbooks.Open (getExprterFilePath)

    'turns screen updating, calculation, and events back on
    With Excel.Application
        .ScreenUpdating = True
        .Calculation = Excel.xlAutomatic
        .EnableEvents = True
    End With

    'closes saved export file
    wbBLE.Close

Ответ 5

Еще один вариант (только в последних версиях excel).

Макросы не удаляются до тех пор, пока книга не будет закрыта после SaveAs .xlsx, поэтому вы можете сделать две SaveAs быстро, не закрывая книгу.

ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, ConflictResolution:=xlLocalSessionChanges
Application.DisplayAlerts = True

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