JRocket1207
New Member
- Joined
- Mar 31, 2020
- Messages
- 3
- Office Version
- 365
- Platform
- Windows
I have the following code that works perfectly until I try to set the page setup options that are colored in red. As soon as I delete those from the code it works flawlessly but the format is not what I want.
I want to print the selected range to PDF and have it formatted as landscape and to be one page wide and one page tall. Any help with this issue would be greatly appreciated!!!!
Private Sub CommandButton1_Click()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
' Export activesheet as PDF
'Selects worksheet 'Sets page fit
'.FitToPagesWide = X where X is equal to number of pages that you want to fit the width to
'or you can use .FitToPagesWide = False if you want it to select as many as needed
'You use .FitToPagesTall = X to do the same with setting the number of pages tall that you want
'Sets Area to be printed to PDF
With Sheets("TMP Daily")
.PageSetup.Orientation = xLandscape
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = "$A$1:$L$31"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = "Daily Production Report"
.To = "XXXXXX" ' <-- Put email of the recipient here
.CC = "XXXXXX" ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & vbLf & vbLf _
& "The daily TMP production report is attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub
I want to print the selected range to PDF and have it formatted as landscape and to be one page wide and one page tall. Any help with this issue would be greatly appreciated!!!!
Private Sub CommandButton1_Click()
Dim IsCreated As Boolean
Dim i As Long
Dim PdfFile As String, Title As String
Dim OutlApp As Object
' Define PDF filename
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"
' Export activesheet as PDF
'Selects worksheet 'Sets page fit
'.FitToPagesWide = X where X is equal to number of pages that you want to fit the width to
'or you can use .FitToPagesWide = False if you want it to select as many as needed
'You use .FitToPagesTall = X to do the same with setting the number of pages tall that you want
'Sets Area to be printed to PDF
With Sheets("TMP Daily")
.PageSetup.Orientation = xLandscape
.PageSetup.Zoom = False
.PageSetup.FitToPagesWide = 1
.PageSetup.FitToPagesTall = 1
.PageSetup.PrintArea = "$A$1:$L$31"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = "Daily Production Report"
.To = "XXXXXX" ' <-- Put email of the recipient here
.CC = "XXXXXX" ' <-- Put email of 'copy to' recipient here
.Body = "Hi," & vbLf & vbLf _
& "The daily TMP production report is attached in PDF format." & vbLf & vbLf _
& "Regards," & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
' Try to send
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
Set OutlApp = Nothing
End Sub