如何在不关闭调用工作簿的情况下使用VBA SaveAs?

时间:2013-09-19 16:10:35

标签: excel vba excel-vba save

我想:

  • 使用模板工作簿进行数据操作
  • 将此工作簿的副本另存为.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"),但在打开时会出错,因为它现在的文件格式无效。

5 个答案:

答案 0 :(得分:6)

这是一种比使用.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

答案 1 :(得分:5)

我做了类似于Siddharth建议的事情,并写了一个函数来处理它,以及处理一些烦恼并提供更多的灵活性。

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 :(得分:2)

在Excel VBA中,这个过程没什么好看或好看的,但是如下所示。 这段代码不能很好地处理错误,很难看,但是应该可以工作。

我们复制工作簿,打开并重新保存副本,然后删除副本。临时副本存储在本地临时目录中,并从那里删除。

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

答案 3 :(得分:1)

我有一个类似的过程,这是我使用的解决方案。它允许用户打开模板,执行操作,在某处保存模板,然后打开原始模板

  1. 用户打开启用宏的模板文件
  2. 做操作
  3. 保存ActiveWorkbook的文件路径(模板文件)
  4. 执行SaveAs
  5. 将ActiveWorkbook(现在是saveas' d文件)设置为变量
  6. 在步骤3中打开模板文件路径
  7. 在第5步中关闭变量
  8. 代码看起来像这样:

        '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
    

答案 4 :(得分:0)

另一种选择(仅在最新版本的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以避免在第二次保存时收到工作簿已存在的警告。