Forum Discussion
Re: Macro to save as PDF with auto filename as cell value
This is code I use.
End SubPrivate Sub Email() Dim objOutlook As Object Dim objMail As Object Dim signature As String Dim oWB As Workbook Set oWB = ActiveWorkbook Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With objMail .Display End With signature = objMail.HTMLbody With objMail .To = oWB.Sheets("Sheet1").Range("A1").Value ''.SentOnBehalfOfName = "" .Subject = strMySubject ''.body = "Dear Sir," & vbNewLine & vbNewLine & "Add stuff here" & vbNewLine & vbNewLine & signature .HTMLbody = "<font face=" & Chr(34) & "Calibri" & Chr(34) & " size=" & Chr(34) & 4 & Chr(34) & ">" & "Dear Sir," & "<br> <br>" & "Add stuff here" & "<br> <br>" & signature & "</font>" .Attachments.Add (strSaveFileName + ".pdf") .Display End With Set objOutlook = Nothing Set objMail = Nothing End Sub
Thanks Andrew
The below works great thanks with one exception. Is there any way if the user enters any of the following \ / : * ? ” < > |anywhere in both cell C5 or C9 a warning appears as these cells form the filename and the file cannot be saved if these symbols are contained anywhere within the text of these cells
Sub emailsavePDF()
Dim objOutlook As Object
Dim objMail As Object
Dim signature As String
Dim oWB As Workbook
Set oWB = ActiveWorkbook
' MsgBox "
'1: A customer must been selected in cell C4" & vbNewLine & "" & vbNewLine & "
'2: A trailer number must be entered in cell C5 and must not contain any symbols" & vbNewLine & "" & vbNewLine & "
'3: A breif repair description must be entered in Cell C9 and must not contain any symbols" & vbNewLine & "" & vbNewLine & "
'4: You are connected to the network", , "THE FOLLOWING STEPS MUST BE COMPLETED"
With Sheets("Estimate")
If .Range("C4") = Empty Then
MsgBox ("A customer must been selected in cell C4 and must not contain any symbols")
End
ElseIf .Range("C5") = Empty Then
MsgBox ("A trailer number must be entered in cell C5 and must not contain any symbols")
End
ElseIf .Range("C9") = Empty Then
MsgBox ("A breif repair description must be entered in Cell C9 and must not contain any symbols")
End
End If
End With
s = Range("O7").Value
'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
s, Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
PDF_File = Range("O7").Value & ".pdf"
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.display
End With
signature = objMail.HTMLbody
With objMail
.To = Sheets("Estimate").Range("O9")
.Cc = Sheets("Estimate").Range("O10")
.Subject = Range("O12").Value
.HTMLbody = "<BODY style=font-size:11pt;font-family:Calibri>Hi;<p>Please find attached estimate for trailer " & Range("O13") & "<p> Any questions please don't hesitate to ask." & "<br> <br>" & signature & "</font>"
.Attachments.Add PDF_File
.Save
.display
End With
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
Sub emailsaveexcel()
Dim newWB As Variant
Dim wb1 As Workbook
Set wb1 = ActiveWorkbook
With wb1
.SaveCopyAs Sheets("Estimate").Range("O5").Text & ".xlsm"
End With
End Sub
ggg
Mark-
You can just error handle for that scenario by using the Replace() Function.
s = Replace(Replace(Replace(Range("O7"), "/", "_"), "\", "_"), ":", "_")
This will replace those special characters with an "_" which is acceptable for file names...
HI Mark,
I would guess you have two options.
1. export the range without formatting (as the formatting happens to the worksheet not the pdf) see this link for an example https://stackoverflow.com/questions/13073888/vba-script-that-saves-excel-range-as-pdf
or
2. copy the data (range) to a prepared,formatted sheet or, new sheet and script the formatting. Then export the whole sheet using the previous examples in this thread.
Hi,
I have been using VBA for over a year, and have used it to refresh multiple pivot tables in a stepwise fashion. I am using Excel 365 for Mac which seems to have introduced some challenges learning from this wonderful thread.
I would be grateful for any assistance.
Essentially, the PDF I would like to print is in a defined range on one of the worksheets in a workbook.
The code below appears only to select the defined range, but does not print to a PDF driver.
Many thanks ML
Sub PDF_Print_Summary()
'
' Print_test Macro
'
'
‘This is the name of the worksheet I want to print
Sheets("Summary").Select
‘This is the range where the report sits in the worksheet
Range("B1:U1").Select
Range(Selection, Selection.End(xlDown)).Select
Range("B1:U82").Select
‘In the set up of the PDF, I would like to be able define some parameters such as narrow margins, using A4 size paper
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$B$1:$U$82"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$B$1:$U$82"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$B$1:$U$82"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$B$1:$U$82"
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintSheetEnd
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Sub
Thanks Matt your a legend, never thought of that. I went with
=O4SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(C5,"/","_"),"\","_"),":","_"),"*","_"),"?","_"),"<","_"),">","_"),"*","_")&" "&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(C9,"/","_"),"\","_"),":","_"),"*","_"),"?","_"),"<","_"),">","_"),"*","_")
