如何在不closures调用工作簿的情况下使用VBA SaveAs？

我要：

• 使用模板工作簿进行数据操作
• 将此工作簿的副本保存为.xlsx（ SaveCopyAs不会让您更改文件types，否则这将非常棒）
• 继续显示原始模板（不是“另存为”一个）

使用SaveAs完全符合预期的要求 – 在删除macros的同时保存工作簿，并向我显示新创build的SavedAs工作簿的视图。

这不幸意味着：

• 除非重新打开，否则我不再查看启用了macros的工作簿
• 代码执行停止在这一点，因为
• 如果我忘记保存，任何macros的改变都会被丢弃（注意：对于生产环境来说这没问题，但是对于开发来说，这是一个巨大的痛苦）

有什么办法可以做到这一点？

 '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会让我把它另存为一个不同的types（例如， templateWb.SaveCopyAs FileName:="myXlsx.xlsx" ），因为它现在有一个无效的文件格式，所以在打开时会出错。

Answer 1

这是比使用.SaveCopyAs创build副本然后打开该副本并执行另存为…更快的方法…

正如我的评论中所提到的，这个过程大约需要1秒钟的时间从一个工作簿创build一个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 

Answer 2

我做了类似于Siddharth的build议，写了一个函数来处理一些烦恼，并提供更多的灵活性。

 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 

Answer 3

在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 

Answer 4

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

1. 用户打开启用macros的模板文件
2. 做操纵
3. 保存ActiveWorkbook的文件path（模板文件）
4. 执行SaveAs
5. 将ActiveWorkbook（现在是saveas'd文件）设置为一个variables
6. 在步骤3中打开模板文件path
7. 在步骤5中closuresvariables

代码看起来像这样：

  '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 

Answer 5

另一种select（只在最新版本的Excel中testing）。

在SaveAs .xlsx之后closures工作簿之前，macros不会被删除，因此您可以在不closures工作簿的情况下快速连续执行两个SaveAs 。

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

注意：您需要closuresDisplayAlerts以避免在第二次保存时收到工作簿已经存在的警告。