我想:
使用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"
),但在打开时会出错,因为它现在的文件格式无效。
答案 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)
我有一个类似的过程,这是我使用的解决方案。它允许用户打开模板,执行操作,在某处保存模板,然后打开原始模板
代码看起来像这样:
'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
以避免在第二次保存时收到工作簿已存在的警告。