| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need a code to print and save file as
Hi Dave
Try this example to save the ActiveSheet in a new workbook Working in 97-2007. If you are sure that this macro will not be used in 2007 the code can be shorter. Sub Copy_ActiveSheet() 'Working in Excel 97-2007 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 '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, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With MsgBox "You can find the new file in " & Application.DefaultFilePath With Application .ScreenUpdating = True .EnableEvents = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Hello, I am new to VB and need a code to print the sheet and then do a save as. The file is going to be a read only with multiple users getting the form, filling it out, printing it and then needing to save the completed form to their own network drive (each user has their own mapped drive from the server as F:\). I can get the printing code down no problem, but am running into some problems trying to save as. Is there also a way to save only one sheet of the workbook whose values are pulled from the other sheets? i.e. a paste special, values only? Does anyone have any suggestions? Thanks for your help Dave |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Need a code to print and save file as
Try this then
Sub Test() Dim fname As Variant Dim NewWb As Workbook ActiveSheet.Copy Set NewWb = ActiveWorkbook fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname NewWb.Close False End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... These answers are helpful, but what I'm looking to do is simply open the save as dialoge box and let each user select where to file away the document, hopefully with a default name (lets say, "123.xls" in cell x1), with an option to change the name, just like a normal save as Any ideas? "Ron de Bruin" wrote: Hi Dave Try this example to save the ActiveSheet in a new workbook Working in 97-2007. If you are sure that this macro will not be used in 2007 the code can be shorter. Sub Copy_ActiveSheet() 'Working in Excel 97-2007 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 '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, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With MsgBox "You can find the new file in " & Application.DefaultFilePath With Application .ScreenUpdating = True .EnableEvents = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Hello, I am new to VB and need a code to print the sheet and then do a save as. The file is going to be a read only with multiple users getting the form, filling it out, printing it and then needing to save the completed form to their own network drive (each user has their own mapped drive from the server as F:\). I can get the printing code down no problem, but am running into some problems trying to save as. Is there also a way to save only one sheet of the workbook whose values are pulled from the other sheets? i.e. a paste special, values only? Does anyone have any suggestions? Thanks for your help Dave |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Need a code to print and save file as
Use this one that also close the new file if you not save it
Sub Test2() Dim fname As Variant Dim NewWb As Workbook ActiveSheet.Copy Set NewWb = ActiveWorkbook fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname NewWb.Close False Set NewWb = Nothing Else NewWb.Close False Set NewWb = Nothing End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... These answers are helpful, but what I'm looking to do is simply open the save as dialoge box and let each user select where to file away the document, hopefully with a default name (lets say, "123.xls" in cell x1), with an option to change the name, just like a normal save as Any ideas? "Ron de Bruin" wrote: Hi Dave Try this example to save the ActiveSheet in a new workbook Working in 97-2007. If you are sure that this macro will not be used in 2007 the code can be shorter. Sub Copy_ActiveSheet() 'Working in Excel 97-2007 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 '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, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With MsgBox "You can find the new file in " & Application.DefaultFilePath With Application .ScreenUpdating = True .EnableEvents = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Hello, I am new to VB and need a code to print the sheet and then do a save as. The file is going to be a read only with multiple users getting the form, filling it out, printing it and then needing to save the completed form to their own network drive (each user has their own mapped drive from the server as F:\). I can get the printing code down no problem, but am running into some problems trying to save as. Is there also a way to save only one sheet of the workbook whose values are pulled from the other sheets? i.e. a paste special, values only? Does anyone have any suggestions? Thanks for your help Dave |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Need a code to print and save file as
Hi Dave
Try this for MyPath = "C:\" Sub Test3() Dim fname As Variant Dim NewWb As Workbook Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\" ChDrive MyPath ChDir MyPath ActiveSheet.Copy Set NewWb = ActiveWorkbook fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname NewWb.Close False Set NewWb = Nothing Else NewWb.Close False Set NewWb = Nothing End If ChDrive SaveDriveDir ChDir SaveDriveDir End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Thanks, I does just what I want! Well, almost.... Do you know if there is a way to change the default save directory away from the current files save path to another place? "Ron de Bruin" wrote: Use this one that also close the new file if you not save it Sub Test2() Dim fname As Variant Dim NewWb As Workbook ActiveSheet.Copy Set NewWb = ActiveWorkbook fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname NewWb.Close False Set NewWb = Nothing Else NewWb.Close False Set NewWb = Nothing End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... These answers are helpful, but what I'm looking to do is simply open the save as dialoge box and let each user select where to file away the document, hopefully with a default name (lets say, "123.xls" in cell x1), with an option to change the name, just like a normal save as Any ideas? "Ron de Bruin" wrote: Hi Dave Try this example to save the ActiveSheet in a new workbook Working in 97-2007. If you are sure that this macro will not be used in 2007 the code can be shorter. Sub Copy_ActiveSheet() 'Working in Excel 97-2007 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 '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, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With MsgBox "You can find the new file in " & Application.DefaultFilePath With Application .ScreenUpdating = True .EnableEvents = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Hello, I am new to VB and need a code to print the sheet and then do a save as. The file is going to be a read only with multiple users getting the form, filling it out, printing it and then needing to save the completed form to their own network drive (each user has their own mapped drive from the server as F:\). I can get the printing code down no problem, but am running into some problems trying to save as. Is there also a way to save only one sheet of the workbook whose values are pulled from the other sheets? i.e. a paste special, values only? Does anyone have any suggestions? Thanks for your help Dave |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Need a code to print and save file as
Here a example, and I add also the code to make values of all cells
It close the original file without saving (change to true if you want to save) I add a reference to the original file in the code Set wb = ActiveWorkbook Sub Test4() Dim fname As Variant Dim wb As Workbook Dim NewWb As Workbook Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\" ChDrive MyPath ChDir MyPath Set wb = ActiveWorkbook ActiveSheet.Copy Set NewWb = ActiveWorkbook 'Change all cells in the worksheet to values With NewWb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname wb.Close False ' close without saving Set NewWb = Nothing Else NewWb.Close False Set NewWb = Nothing End If ChDrive SaveDriveDir ChDir SaveDriveDir End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Thanks alot, I couldn't have done this without you!! One last question you may know the answer to, when coping and closing, can you close the original file instead of the copy? "Ron de Bruin" wrote: Hi Dave Try this for MyPath = "C:\" Sub Test3() Dim fname As Variant Dim NewWb As Workbook Dim MyPath As String Dim SaveDriveDir As String SaveDriveDir = CurDir MyPath = "C:\" ChDrive MyPath ChDir MyPath ActiveSheet.Copy Set NewWb = ActiveWorkbook fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname NewWb.Close False Set NewWb = Nothing Else NewWb.Close False Set NewWb = Nothing End If ChDrive SaveDriveDir ChDir SaveDriveDir End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Thanks, I does just what I want! Well, almost.... Do you know if there is a way to change the default save directory away from the current files save path to another place? "Ron de Bruin" wrote: Use this one that also close the new file if you not save it Sub Test2() Dim fname As Variant Dim NewWb As Workbook ActiveSheet.Copy Set NewWb = ActiveWorkbook fname = Application.GetSaveAsFilename("myfile", _ fileFilter:="Excel Files (*.xls), *.xls") If fname < False Then NewWb.SaveAs fname NewWb.Close False Set NewWb = Nothing Else NewWb.Close False Set NewWb = Nothing End If End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... These answers are helpful, but what I'm looking to do is simply open the save as dialoge box and let each user select where to file away the document, hopefully with a default name (lets say, "123.xls" in cell x1), with an option to change the name, just like a normal save as Any ideas? "Ron de Bruin" wrote: Hi Dave Try this example to save the ActiveSheet in a new workbook Working in 97-2007. If you are sure that this macro will not be used in 2007 the code can be shorter. Sub Copy_ActiveSheet() 'Working in Excel 97-2007 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 '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, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum .Close SaveChanges:=False End With MsgBox "You can find the new file in " & Application.DefaultFilePath With Application .ScreenUpdating = True .EnableEvents = True End With End Sub -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Dave M" wrote in message ... Hello, I am new to VB and need a code to print the sheet and then do a save as. The file is going to be a read only with multiple users getting the form, filling it out, printing it and then needing to save the completed form to their own network drive (each user has their own mapped drive from the server as F:\). I can get the printing code down no problem, but am running into some problems trying to save as. Is there also a way to save only one sheet of the workbook whose values are pulled from the other sheets? i.e. a paste special, values only? Does anyone have any suggestions? Thanks for your help Dave |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Row height looks good but when I save the file &go to print it hgt | Excel Discussion (Misc queries) | |||
| FILE 'SAVE AS' IN VBA CODE | Excel Discussion (Misc queries) | |||
| function to print to PDF and save PDF file | Excel Programming | |||
| Macro to save file and print document | Excel Programming | |||
| FILE Save As / FILE Print greyed out in Excel | Excel Programming | |||
Linear Mode
