May 30 2017
03:39 AM
- last edited on
Jul 25 2018
09:35 AM
by
TechCommunityAP
May 30 2017
03:39 AM
- last edited on
Jul 25 2018
09:35 AM
by
TechCommunityAP
Hi I recently used the following Macro, provided by Gary's Student, to create a PDF from an active sheet, generate a unique Filename based on a cell ref and save it to a specific location.
This macro works well for me, however, I would like to add to it so that I can also attach it too and email and send to a specific email group (using Outlook). Maybe have it allow you to View so it can be sent manually, or the option to automatically send.
Below is the value I used to create the filename based on the date entry within I3 and I formatted it as shown.
Cell H1 "=I:\2017 - 2018\Operations Unit\Day Sheets\"&"DS_"&TEXT(I3,"yymmdd")&".PDF"
Sub Macro1()
s = Range("H1").Value
'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
s, Quality:=xlQualityStandard, IncludeDocProperties _
:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Jul 11 2018 12:29 PM
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,"/","_"),"\","_"),":","_"),"*","_"),"?","_"),"<","_"),">","_"),"*","_")
Aug 21 2018 11:49 PM
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
Aug 22 2018 03:36 PM
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 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.
Dec 21 2018 01:56 PM
Jun 30 2020 07:28 PM
code as you share not works in window 7/10 64 bit . my cvode be below
Declare Function RegOpenKeyA Lib "advapi32.dll" ( _
ByVal Key As Long, _
ByVal SubKey As String, _
NewKey As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal cbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" ( _
ByVal hKey As Long) As Long
Sub PrintPDF()
Dim sPath As String
Dim strDefaultPrinter As String
Dim strOutFile As String
Dim lngRegResult As Long
Dim lngResult As Long
Dim dhcHKeyCurrentUser As Long
Dim PDFPath As String
Const dhcRegSz As Long = 1
dhcHKeyCurrentUser = &H80000001
strDefaultPrinter = Application.ActivePrinter
sPath = "D:\JOBCARD201920"
PDFPath = sPath
strOutFile = PDFPath & "\" & Range("G3").VALUE & ".pdf"
lngRegResult = RegOpenKeyA(dhcHKeyCurrentUser, "Software\Adobe\Acrobat Distiller\PrinterJobControl", _
lngResult)
lngRegResult = RegSetValueEx(lngResult, Application.Path & "\Excel.exe", 0&, dhcRegSz, ByVal strOutFile, Len(strOutFile))
lngRegResult = RegCloseKey(lngResult)
ThisWorkbook.ActiveSheet.PrintOut copies:=1, ActivePrinter:="Adobe PDF"
Application.ActivePrinter = strDefaultPrinter
end sub
Dec 15 2021 06:32 AM
old post but wondering if you could help as this is very close to what I need, however I am a VBA novice and I can't make the small changes work in my favour!!
I need a code to do the following:
> Save active worksheet only as a PDF, as the name from cell "M7"
> Save in to specific file path however with a variable final location based on specific name, taken from cell "W3"
> Open Outlook and attached this PDF file in a new email
> Add Subject of "PO & PDF File Name (or cell "M7")
> Add body of "Hi (line break x2) *insert text* (line break x2) *Date & cell "M10"* (line break x1) *Booking Slot & Cell "W6"* (line break x2) *insert text* (line break x2) *Regards*
Would be really grateful if you are able to help.
Thanks
James
Dec 15 2021 07:17 AM
Hi Matt, found this code and it is very close to what I am after, however I am a complete VBA novice and the small changes I need to make I can't seem to make work. Are you able to advise? Would be really appreciated.
So I need to do the following if possible:
> Save the active worksheet as a PDF, using Cell "M7" for the name and saved in to a specific file path (which I will put in to the code), however with the final folder name to save in to being specific to Cell "W3" which will change via a drop down option
> Open Outlook new email and attached the PDF
> In "to" use email addresses from Cell "X3, Y3 and Z3" (sometimes 1 or 2 of these may be blank, will this cause an error?)
> In subject add "PO & Cell M7 (or PDF File name)
> In body add "Text" (line break x2) "text" (line break x2) "text & Cell M10" (line break x1) "text & Cell W6" (line break x2) "text" (line break x2) "text" end
Thanks
James