Hi,
I'm trying to work with VBA to export multiple Excel tab ranges to a PDF. The range of data depends on the results.
The code below wont work.
Public Sub Monthend_All_Sheets_PDF()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lastI As Long, lastQ As Long
Dim PDFranges As Range
On Error GoTo errHandler
With ActiveSheet
lastE = .Cells(.Rows.Count, "E").End(xlUp).Row
lastH = .Cells(.Rows.Count, "H").End(xlUp).Row
lastI = .Cells(.Rows.Count, "I").End(xlUp).Row
lastQ = .Cells(.Rows.Count, "Q").End(xlUp).Row
Set PDFranges = .Range("Monthend!A2:E" & lastE & ",Monthend!G2:H" & lastH & ",BO Sales Summary!A2:I" & lastI & ",BO Sales Summary!K2:Q" & lastQ)
End With
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
strPath = "D:\Dropbox\Shared_Files\dana_jordan\Reports"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
strFile = ActiveSheet.Range("A2").Value & " - " & strTime & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
I'm trying to work with VBA to export multiple Excel tab ranges to a PDF. The range of data depends on the results.
The code below wont work.
Public Sub Monthend_All_Sheets_PDF()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim lastI As Long, lastQ As Long
Dim PDFranges As Range
On Error GoTo errHandler
With ActiveSheet
lastE = .Cells(.Rows.Count, "E").End(xlUp).Row
lastH = .Cells(.Rows.Count, "H").End(xlUp).Row
lastI = .Cells(.Rows.Count, "I").End(xlUp).Row
lastQ = .Cells(.Rows.Count, "Q").End(xlUp).Row
Set PDFranges = .Range("Monthend!A2:E" & lastE & ",Monthend!G2:H" & lastH & ",BO Sales Summary!A2:I" & lastI & ",BO Sales Summary!K2:Q" & lastQ)
End With
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
strPath = "D:\Dropbox\Shared_Files\dana_jordan\Reports"
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
strFile = ActiveSheet.Range("A2").Value & " - " & strTime & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub