Command Button to combine multiple worksheets into 1 pdf
Hello,
I have found some things that sorta do what I want, but cannot get it to work exactly right. I have a XLS file with multiple worksheets in it, I want to combine 3 of those worksheets into a pdf, save the pdf in a specified location, and open outlook and attach file for sending. I would like to name the pdf a value from with the workbook as well.
I know this isn't that much info, but I feel like a solution like this is most likely already developed, I just cant find it.
[vba]Sub exportToPdfallSheet1pdf()
Dim mySheets As Sheets
Dim SaveToPath As String
Set mySheets = Worksheets(Array("Sheet1", "Sheet3"))
filenameSave = "C:\test\copy.pdf"
With ConsolidationSheet(mySheets, "")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=filenameSave, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
Function ConsolidationSheet(mySheets As Sheets, Optional SheetHeader As Variant) As Worksheet
Dim tempSheet As Worksheet
Dim StartNewSheetRow As Long, StartNewSheetCell As Range
Dim i As Long
With mySheets(1).Parent
Set tempSheet = .Worksheets.Add(before:=.Sheets(1))
End With
For i = 1 To mySheets.Count
StartNewSheetRow = ReallyUsedRange(tempSheet).Rows.Count + 1
Set StartNewSheetCell = tempSheet.Cells(StartNewSheetRow, 1)
Select Case TypeName(SheetHeader)
Case "String"
If SheetHeader = vbNullString Then
tempSheet.Cells(StartNewSheetRow, 1).Value = mySheets(i).Name
Else
tempSheet.Cells(StartNewSheetRow, 1).Value = SheetHeader
End If
Case "Range"
tempSheet.Cells(StartNewSheetRow, 1).Value = mySheets(i).Range(SheetHeader.Cells(1, 1).Address).Text
End Select
StartNewSheetRow = ReallyUsedRange(tempSheet).Rows.Count + 1
ReallyUsedRange(mySheets(i)).Copy Destination:=tempSheet.Cells(StartNewSheetRow, 1)
tempSheet.HPageBreaks.Add before:=StartNewSheetCell
Next i
tempSheet.Rows(1).Delete
Set ConsolidationSheet = tempSheet
End Function
[/vba]
I'm sorry, I forgot a function
[VBA]Function ReallyUsedRange(aSheet As Worksheet) As Range
Dim lastRow As Long, lastColumn As Long
Dim i As Long
With aSheet
lastRow = 0
For i = 1 To .UsedRange.Columns.Count + .UsedRange.Column
lastRow = Application.Max(.Cells(.Rows.Count, i).End(xlUp).Row, lastRow)
Next i
lastColumn = 0
For i = 1 To lastRow
lastColumn = WorksheetFunction.Max(.Cells(i, .Columns.Count).End(xlToLeft).Column, lastColumn)
Next i
Set ReallyUsedRange = .Range("A1").Resize(lastRow, lastColumn)
End With
End Function[/VBA]
couple of issues, when the function creates the temp sheet, my formatting and column widths do no transfer, how can I fix this? Also, I want to be able to save the pdf using a combination of 2 values from within the worksheet.
Reply With Quote
