 Back to jkp-ads.com |
Ron de Bruin
|
 |
|
Back to jkp-ads.com |
Ron de Bruin
|
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
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 (xls) in 97-2003 because there are no other Excel file formats before
Excel 2007.
But because there are so many new file formats in Excel
2007-2016, we shouldn't use code like this that does not specify the
FileFormat parameter. In Excel 2007-2016, SaveAs requires you to provide
both the FileFormat parameter and the correct file extension.
For
example, in Excel 2007-2016, 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-2016)
These are the main file formats in Excel 2007-2016, Note:
In Excel for the Mac the values are +1
51 =
xlOpenXMLWorkbook (without macro's in 2007-2016, xlsx)
52
= xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2016, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2016 with or
without macro's, xlsb)
56 = xlExcel8 (97-2003 format in
Excel 2007-2016, 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).
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-2016 , Example 2 you can
use in Excel 2000-2016.
If you run the code in Excel 2007-2016 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 worksheet 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
Sub Copy_ActiveSheet_1() 'Working in Excel 97-2016 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-2016 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 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-2016 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