PDA

View Full Version : [SOLVED:] Exporting Multiple Sheets as Excel & PDF



LordDragon
06-30-2015, 02:40 PM
Greetings,


I will be posting this on VBA Express, Mr. Excel, & Excel Forum. I apologize if this counts as a "duplicate post".


I have an Inventory/Order Form workbook that I'm building that allows the user to create an order from the inventory of available parts, consolidate the duplicates and export the order as either an Excel file or a PDF; but doesn't export the rest of the inventory.


All that stuff works great. But now I have been tasked with including the customer information. So I added a page that will contain that info, but it needs to be exported also. What I would like is to simply save the Customer Info page and the Order Info page into an Excel Workbook. I also would like to save them both into a single PDF file, with the Customer Info on the first page.


Here is the code I am currently using for both.


Excel




Sub CreateXLS()
'Saves the Order Info page as a separate Excel workbook.


Dim strFile As String

strFile = ThisWorkbook.Path & "\"


If Dir(strFile, vbDirectory) = "" Then
MkDir (strFile)
End If

'Save the Order Info page as an Excel Workbook
ActiveSheet.Copy
With ActiveWorkbook
.SaveAs strFile & .Sheets(1).Name
.Close 0
End With


End Sub



PDF




Sub CreatePDF()
'Saves the Order Info page as a PDF file.


Dim strFile As String

strFile = ThisWorkbook.Path & "\"

If Dir(strFile, vbDirectory) = "" Then
MkDir (strFile)
End If

'Save the Order Info page as a PDF
Application.Goto Sheets("Order Info").Range("A1"), True
With Sheets("Order Info")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & "Order Info.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

End Sub



How can I change either one to do what I need?


Thanks.

Kenneth Hobs
07-01-2015, 08:48 AM
There is a cross-posting etiquette that I am sure you will be pointed to.

In both routines, if the path does not exist to the active workbook, you can't create the path from it. In my example, I just told the user to save the file but it sounds like that is not really needed. What I would normally do in that case would be to let the user browse and save the file.

Here is my method for your 2nd routine to create the PDF.

Sub CreatePDF2()
Dim ws As Worksheet

Set ws = ActiveSheet

If ThisWorkbook.Path = "" Then
MsgBox "Save File First"
Exit Sub
End If

'Order worksheets for proper pdf creation in order
Worksheets("Customer Info").Move after:=Worksheets(Worksheets.Count)
Worksheets("Order Info").Move after:=Worksheets(Worksheets.Count)

With Sheets("Order Info")
Worksheets(Array("Customer Info", "Order Info")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\CustomerOrderInfo.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

ws.Select
End Sub

LordDragon
07-07-2015, 06:23 PM
This worked great. I made a few minor changes because I decided I wanted the file name to be the name of the customer & ship date. Otherwise, this does exactly what I wanted it to, for PDF. Now I need to get the Export to Excel part working.

Thanks.

Kenneth Hobs
07-07-2015, 07:16 PM
I don't know if you want one or more sheets saved. Here is how to do one.

Worksheets("Sheet2").SaveAs Thisworkbook.Path & "\Sheet2.xlsx", xlOpenXMLWorkbook

LordDragon
07-07-2015, 08:02 PM
Mr. Hobs,

Thanks for the quick reply. I'm looking to do two pages. The same two from the PDF code above. I'm giving the user the option of saving the two pages as either Excel or as PDF. Either way, they'll need the Customer Info page and the Order Info page.

Thanks for the help.

Kenneth Hobs
07-07-2015, 09:05 PM
Not sure if you want to save it as xlsx or xlsm. This can be a bit slicker but one way could be:

Sub ken()
Dim wb As Workbook, swb As String, ws As Worksheet
swb = ActiveWorkbook.FullName

On Error GoTo EndSub
Application.DisplayAlerts = False

ThisWorkbook.Save
ThisWorkbook.SaveAs _
ThisWorkbook.Path & "\CustOrd.xlsx", xlOpenXMLWorkbook
Set wb = ActiveWorkbook

For Each ws In wb.Worksheets
If ws.Name <> "Customer Info" And ws.Name <> "Order Info" Then _
ws.Delete
Next ws

Workbooks.Open swb
wb.Close True

EndSub:
Application.DisplayAlerts = True
End Sub

Kenneth Hobs
07-08-2015, 07:25 AM
This method is a bit slicker. Just replace the sheet names in the array and the filename to save it as.

Public Sub Save2()
Application.ScreenUpdating = False
Application.DisplayAlerts = False


'Sheets(Array("LastFirst", "FirstLast")).Copy 'Index order
Sheets(Array("FirstLast", "LastFirst")).Copy 'Same as above, index matters, not array order.
With ActiveWorkbook
.SaveAs FileName:="c:\t\LF.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'Change path to suit
.Close
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

LordDragon
07-08-2015, 01:07 PM
Ken,

I didn't try the most recent code you posted here, but I did use the other one. I made the changes I needed to in order to make it work with the rest of what I was doing, but it worked.

Thanks.