Help saving a autopopulate .pdf

cskelk

New Member
Joined
Jun 9, 2021
Messages
7
Office Version
  1. 365
Platform
  1. Windows
My code is working great for Printing to PDF, however today it finially dawned on me that if I print to PDF I will no longer have access to Blank Fillable boxes on my PDF, and I desperatly need that. So I'm asking for some help changing the code. Instead of Print to PDF I need SAVE AS. The file name has to remain the same

The First Macro picks the template doc

Sub PDFTemplate()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFilePicker)
With PDFFldr
.Title = "Select PDF file to Attach"
.Filters.Add "PDF Type Files", "*.pdf' , 1"
If .Show <> -1 Then GoTo NoSelection
Sheet2.Range("D8").Value = .SelectedItems(1)
End With
NoSelection:
End Sub


The second Macro you click a button and choose the folder you want to save the document in.

Sub SavePDFFolder()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFolderPicker)
With PDFFldr
.Title = "Select a Folder"
If .Show <> -1 Then GoTo NoSel
Sheet2.Range("D14").Value = .SelectedItems(1)
End With
NoSel:
End Sub

The Last Macro is another button to execute the population of the PDF

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, LastName As String
Dim CustRow, LastRow As Long
Dim Pluto As String
Pluto = Space(1)
With Sheet2
LastRow = .Range("A9999").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("D8").Value 'File Template Cell Location
SavePDFFolder = .Range("D14").Value 'Save Folder Cell Location
SaveDate = .Range("G16").Value ' File name Date
TrainingCode = .Range("E18").Value 'Cert Abreviation

ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00006

For CustRow = 26 To LastRow 'LastRow
Firstname = .Range("D" & CustRow).Value 'FirstName
middleInitial = .Range("C" & CustRow).Value 'Middle Initial
LastName = .Range("B" & CustRow).Value 'Last Name
Application.Wait Now + 0.00003
Application.SendKeys "{Tab}", True 'Name Box
Application.SendKeys Firstname, True
Application.SendKeys " ", True
Application.SendKeys middleInitial, True
Application.SendKeys ".", True
Application.SendKeys " ", True
Application.SendKeys LastName, True
Application.Wait Now + 0.00002

EmployeeSSN = .Range("E" & CustRow).Value
Application.SendKeys "{Tab}", True 'Employee SSN
Application.SendKeys EmployeeSSN, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True
AcademyID = .Range("A" & CustRow).Value 'AcademyID
Application.SendKeys "Academy ID - ", True
Application.SendKeys AcademyID, True
Application.Wait Now + 0.00001

Application.SendKeys "{Tab}", True

OJT = .Range("F" & CustRow).Value 'OJT
Application.SendKeys OJT, True
Application.Wait Now + 0.00003


Application.SendKeys "^(p)", True 'Print to PDF
Application.Wait Now + 0.00003
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00005

If Dir(SavePDFFolder & "\" & AcademyID & "_" & LastName & ", " & Firstname & " " & middleInitial & "._" & TrainingCode & "_" & SaveDate & ".pdf") <> Empty Then Kill (SavePDFFolder & "\" & AcademyID & "_" & LastName & ", " & Firstname & " " & middleInitial & "._" & TrainingCode & "_" & SaveDate & ".pdf")
Application.SendKeys "%(n)", True
Application.Wait Now + 0.00001
Application.SendKeys SavePDFFolder & "\" & AcademyID & "_" & LastName & ", " & Firstname & " " & middleInitial & "._" & TrainingCode & "_" & SaveDate & ".pdf"

Application.Wait Now + 0.00005
Application.SendKeys "%(s)", True
Application.Wait Now + 0.00002

Next CustRow

Application.SendKeys "^(q)", True
Application.SendKeys "{numlock}%s", True


End With
End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

Forum statistics

Threads
1,148,160
Messages
5,745,123
Members
423,927
Latest member
Pra56

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top