[心缘地方]同学录
首页 | 功能说明 | 站长通知 | 最近更新 | 编码查看转换 | 代码下载 | 常见问题及讨论 | 《深入解析ASP核心技术》 | 王小鸭自动发工资条VBA版
登录系统:用户名: 密码: 如果要讨论问题,请先注册。

[转贴]Use VBA SaveAs and CheckCompatibility in Excel 2007-2010

上一篇:[转]膨胀螺栓
下一篇:[转帖]VBA常用操作

添加日期:2010/3/4 22:25:19 快速返回   返回列表 阅读5758次
http://www.rondebruin.nl/saveas.htm

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.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End 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


Use CheckCompatibility to save 2007-2010 file as 97-2003 workbook

If you save a 2007-2010 file with things that are new in 2007-2010 as an Excel 97-2003 file you will notice that you see a dialog that asked you if you want to continue to save the file as 97-2003. See the screenshot below that you see if you use for example formatting that is new in 2007-2010.


按此在新窗口浏览图片

If you want to avoid this dialog when you use VBA to save the ActiveSheet from a 2007 file in a new workbook as 97-2003 file see the small test example below that turn off CheckCompatibility.
Note: It seems that the default DefaultSaveFormat must be 97-2003 in 2007 before CheckCompatibility is working, the code below will change the default to 97-2003 temporary and after the code is ready restore it to his original setting.


Sub Save_2007_WorkSheet_As_97_2003_Workbook()
'Avoid CheckCompatibility dialog when you copy a WorkSheet
'from a 2007-2010 file with things that are new in 2007-2010
'to a new workbook and save this workbook as a 97-2003 workbook
    Dim Destwb As Workbook
    Dim SaveFormat As Long
    Dim TempFilePath As String
    Dim TempFileName As String

    'Remember the users setting
    SaveFormat = Application.DefaultSaveFormat
    'Set it to the 97-2003 file format
    Application.DefaultSaveFormat = 56

    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    Destwb.CheckCompatibility = False

    'Save the new workbook and close it
    TempFilePath = Application.DefaultFilePath & "\"
    TempFileName = "97-2003 WorkBook " & Format(Now, "yyyy-mm-dd hh-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & ".xls", FileFormat:=56
        .Close SaveChanges:=False
    End With

    'Set DefaultSaveFormat back to the users setting
    Application.DefaultSaveFormat = SaveFormat
End Sub



Code examples


Sub Copy_ActiveSheet_1()
'Working in Excel 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            '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 Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End 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 it
    TempFilePath = 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:=False
    End With

    MsgBox "You can find the new file in " & TempFilePath 

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub



Sub Copy_ActiveSheet_2()
'Working in Excel 2000-2010
    Dim fname As Variant
    Dim NewWb As Workbook
    Dim FileFormatValue As Long

    'Check the Excel version
    If Val(Application.Version) < 9 Then Exit Sub
    If Val(Application.Version) < 12 Then

        'Only choice in the "Save as type" dropdown is Excel files(xls)
        'because the Excel version is 2000-2003
        fname = 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 workbook
            ActiveSheet.Copy
            Set NewWb = ActiveWorkbook

            'We use the 2000-2003 format xlWorkbookNormal here to save as xls
            NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False
            NewWb.Close False
            Set NewWb = Nothing

        End If
    Else
        '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 list
        
        fname = 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" list
        If fname <> False Then
            Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else
                'Copies the ActiveSheet to new workbook
                ActiveSheet.Copy
                Set NewWb = ActiveWorkbook

                'Save the file in the format you choose in the "Save as type" dropdown
                NewWb.SaveAs fname, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                NewWb.Close False
                Set NewWb = Nothing

            End If
        End If
    End If
End Sub



============================================
在Excel2007的VBA中,如何用Workbooks.add或Workbooks.save(s)打开或保存为Excel2003 格式文档。

Workbooks.Add
ActiveWorkbook.SaveAs "D:\123.xls", xlExcel8

非常感谢方漠版主,另外再请教一个小问题:如何检测正在使用的Excel版本呢???
我是这样想的,如果检测到是2007版测用ActiveWorkbook.SaveAs "D:\123.xls", xlExcel8,如果是2003版则使用ActiveWorkbook.Save。
再次感谢!!!

哦知道了!用Application.version
 

评论 COMMENTS
没有评论 No Comments.

添加评论 Add new comment.
昵称 Name:
评论内容 Comment:
验证码(不区分大小写)
Validation Code:
(not case sensitive)
看不清?点这里换一张!(Change it here!)
 
评论由管理员查看后才能显示。the comment will be showed after it is checked by admin.
CopyRight © 心缘地方 2005-2999. All Rights Reserved