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

我想：

• 使用模板工作簿执行数据操作
• 将本工作手册另存一份为.xlsx（不允许您更改文件类型，否则这将非常好）
• 继续显示原始模板（不是“另存为”模板）

使用

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文件名：=“myXlsx.xlsx”

），打开时会出现错误，因为它现在的文件格式无效。

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

---

这里有一个比使用

.SaveCopyAs

创建副本然后打开该副本并执行另存为操作快得多的方法

正如我在评论中提到的，从一个包含10个工作表（每个工作表包含100行*20列数据）的工作簿创建xlsx副本需要大约1秒的时间

---

我做了一些类似于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

---

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

用户打开启用宏的模板文件

操纵

保存Active工作簿的文件路径（模板文件）

执行SaveAs

将ActiveWorkbook（现在是saveas'd文件）设置为变量

在步骤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

另一个选项（仅在最新版本的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

以避免在第二次保存时收到工作簿已存在的警告。

我能想到的一个蹩脚的解决方法是将副本另存为，打开副本，将其另存为所需格式，删除副本。如果你把它塞进一个子文件夹，那么它就不会扰乱你的主要程序。使用

SaveCopyAs

创建一个副本，然后打开该副本并执行另存为？@Cor_Blimey:对不起，没有看到你的评论或创建一个新工作簿，将所有工作表复制到该文件夹中，然后将其保存为xlsx？这两个选项都会让我有点内疚（好很多）@天哪，一开始我当然也想过这样做，但现在看来应该有更好的办法。我使用的是网络驱动器，因此将它们的多次节省降至最低是理想的。+1，这与我最终得到的结果非常相似-我使其更加健壮并成为一个函数。此外，对于每种驱动器，

。。。ws.Delete

就是这样一个黑客；）这取决于您使用的Excel版本。使用Excel 2003复制工作表不是一种安全的操作，可能会导致数据丢失。哦，是的，还有：

Application.sheetsinewworkbook=1

可以避免您必须删除任意数量的工作表，并在下一步恢复出现错误的

。您应该从

Application.SheetSinewWorkbook

中保存值，并在Sub.@SiddharthRout IIRC的末尾将其还原。可能会发生一些错误。例如，一个快速的谷歌搜索出现了。出于好奇，你为什么复制工作表而不从临时文件中移动它们？移动将自动关闭工作簿。无论如何，我可以看出这比保存副本、打开等要快，但如果您打算将此方法用于包含表格、公式、定义名称等的工作表，则可能不会太好（尽管您将此方法用于控制的模板时，我想您知道这不是问题）@Cor_Blimey我想保持模板完整，并使用类似于“SaveCopyAs”的功能-如果我移动表格，我会从模板工作簿中丢失它们。哎哟-我看不到这个目标。谢谢

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