How to use VBA SaveAs without closing calling workbook?

后端 未结 5 575
谎友^
谎友^ 2020-11-27 23:44

I want to:

  • Do data manipulation using a Template workbook
  • Save a copy of this work book as .xlsx (SaveCopyAs doesn\'t let you change filetypes, otherw
5条回答
  •  一向
    一向 (楼主)
    2020-11-28 00:08

    I did something similar to what Siddharth suggested and wrote a function to do it as well as handle some of the annoyances and offer some more flexibility.

    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
    

提交回复
热议问题