龙吐珠的浇水注意事项:Use VBA SaveAs in Excel 2007-2010

来源:百度文库 编辑:九乡新闻网 时间:2024/07/14 06:05:04
Use VBA SaveAs in Excel 2007-2010
Ron de Bruin (last update 2-Jan-2010)
Go back to the Excel tips page

You see a lot of old SaveAs code that does not specify the FileFormat
parameter. In Excel versions before Excel 2007, code without this parameter
will not cause too many problems because Excel will use the current FileFormat
of the existing file -- and the default FileFormat for new files is a normal workbook.

But because there are so many new file formats in Excel 2007-2010, we shouldn't
use code like this that does not specify the FileFormat parameter.

In Excel 2007-2010, SaveAs requires you to provide both the FileFormat parameter
and the correct file extension.

For example, in Excel 2007-2010, this will fail if the ActiveWorkbook is not an xlsm file
ActiveWorkbook.SaveAs "C:\ron.xlsm"

This code will always work
ActiveWorkbook.SaveAs "C:\ron.xlsm", fileformat:=52
' 52 = xlOpenXMLWorkbookMacroEnabled = xlsm (with macro's in 2007-2010)


These are the main file formats in Excel 2007-2010:

51 = xlOpenXMLWorkbook (without macro's in 2007-2010, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2010, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2010 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2010, xls)

Note: I always use the FileFormat numbers instead of the defined constants
in my code so that it will compile OK when I copy the code into an Excel
97-2003 workbook. (For example, Excel 97-2003 won't know what the
xlOpenXMLWorkbookMacroEnabled constant is.)


Examples

Below are two basic code examples to copy the ActiveSheet to a new Workbook
and save it in a format that matches the file extension of the parent workbook.
The second example use GetSaveAsFilename to ask you for a file path/name.
(Example 1 you can use in Excel 97-2010 , Example 2 you can use in Excel 2000-2010)

If you run the code in Excel 2007-2010 it will look at the FileFormat of the parent workbook and
save the new file in that format. Only if the parent workbook is an xlsm file and if there is no
VBA code in the new workbook it will save the new file as xlsx.
If the parent workbook is not an xlsx, xlsm or xls then it will be saved as xlsb.

If you always want to save in a certain format you can replace this part of the macro
                 Select Case Sourcewb.FileFormatCase 51: FileExtStr = ".xlsx": FileFormatNum = 51Case 52:If .HasVBProject ThenFileExtStr = ".xlsm": FileFormatNum = 52ElseFileExtStr = ".xlsx": FileFormatNum = 51End IfCase 56: FileExtStr = ".xls": FileFormatNum = 56Case Else: FileExtStr = ".xlsb": FileFormatNum = 50End Select
With one of the one liners from this list

FileExtStr = ".xlsb": FileFormatNum = 50
FileExtStr = ".xlsx": FileFormatNum = 51
FileExtStr = ".xlsm": FileFormatNum = 52


Or maybe you want to save the one sheet workbook to csv, txt or prn.
(you can use this also if you run the code in Excel 97-2003)

FileExtStr = ".csv": FileFormatNum = 6
FileExtStr = ".txt": FileFormatNum = -4158
FileExtStr = ".prn": FileFormatNum = 36



Code examples
Sub Copy_ActiveSheet_1()'Working in Excel 97-2010Dim FileExtStr As StringDim FileFormatNum As LongDim Sourcewb As WorkbookDim Destwb As WorkbookDim TempFilePath As StringDim TempFileName As StringWith Application.ScreenUpdating = False.EnableEvents = FalseEnd WithSet Sourcewb = ActiveWorkbook'Copy the sheet to a new workbookActiveSheet.CopySet Destwb = ActiveWorkbook'Determine the Excel version and file extension/formatWith DestwbIf Val(Application.Version) < 12 Then'You use Excel 97-2003FileExtStr = ".xls": FileFormatNum = -4143Else            'You use Excel 2007-2010'We exit the sub when your answer is NO in the security dialog that you'only see when you copy a sheet from a xlsm file with macro's disabled.If Sourcewb.Name = .Name ThenWith Application.ScreenUpdating = True.EnableEvents = TrueEnd WithMsgBox "Your answer is NO in the security dialog"Exit SubElseSelect Case Sourcewb.FileFormatCase 51: FileExtStr = ".xlsx": FileFormatNum = 51Case 52:If .HasVBProject ThenFileExtStr = ".xlsm": FileFormatNum = 52ElseFileExtStr = ".xlsx": FileFormatNum = 51End IfCase 56: FileExtStr = ".xls": FileFormatNum = 56Case Else: FileExtStr = ".xlsb": FileFormatNum = 50End SelectEnd IfEnd IfEnd With    '    'Change all cells in the worksheet to values if you want'    With Destwb.Sheets(1).UsedRange'        .Cells.Copy'        .Cells.PasteSpecial xlPasteValues'        .Cells(1).Select'    End With'    Application.CutCopyMode = False'Save the new workbook and close itTempFilePath = Application.DefaultFilePath & "\"TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "yyyy-mm-dd hh-mm-ss")With Destwb.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum.Close SaveChanges:=FalseEnd WithMsgBox "You can find the new file in " & TempFilePathWith Application.ScreenUpdating = True.EnableEvents = TrueEnd WithEnd SubSub Copy_ActiveSheet_2()'Working in Excel 2000-2010Dim fname As VariantDim NewWb As WorkbookDim FileFormatValue As Long'Check the Excel versionIf Val(Application.Version) < 9 Then Exit SubIf Val(Application.Version) < 12 Then        'Only choice in the "Save as type" dropdown is Excel files(xls)'because the Excel version is 2000-2003fname = Application.GetSaveAsFilename(InitialFileName:="", _filefilter:="Excel Files (*.xls), *.xls", _Title:="This example copies the ActiveSheet to a new workbook")If fname <> False Then'Copy the ActiveSheet to new workbookActiveSheet.CopySet NewWb = ActiveWorkbook'We use the 2000-2003 format xlWorkbookNormal here to save as xlsNewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=FalseNewWb.Close FalseSet NewWb = NothingEnd IfElse        'Give the user the choice to save in 2000-2003 format or in one of the'new formats. Use the "Save as type" dropdown to make a choice,Default ='Excel Macro Enabled Workbook. You can add or remove formats to/from the listfname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _" Excel Macro Free Workbook (*.xlsx), *.xlsx," & _" Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _" Excel 2000-2003 Workbook (*.xls), *.xls," & _" Excel Binary Workbook (*.xlsb), *.xlsb", _FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook")'Find the correct FileFormat that match the choice in the "Save as type" listIf fname <> False ThenSelect Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))Case "xls": FileFormatValue = 56Case "xlsx": FileFormatValue = 51Case "xlsm": FileFormatValue = 52Case "xlsb": FileFormatValue = 50Case Else: FileFormatValue = 0End Select            'Now we can create/Save the file with the xlFileFormat parameter'value that match the file extensionIf FileFormatValue = 0 ThenMsgBox "Sorry, unknown file extension"Else'Copies the ActiveSheet to new workbookActiveSheet.CopySet NewWb = ActiveWorkbook'Save the file in the format you choose in the "Save as type" dropdownNewWb.SaveAs fname, FileFormat:= _FileFormatValue, CreateBackup:=FalseNewWb.Close FalseSet NewWb = NothingEnd IfEnd IfEnd IfEnd Sub

Compatibility Checker in Excel 2007-2010