Otomatik Veri doldur ve Kaydet code

[yeliz.yilmaz]

Merhabalar,

Excel tablodaki verileri pdf dosyasindaki ilgili alanlara teker teker yazdırıktan sonra, bu dosyayi pdf olarak kaydedecek bir vba code buldum. ama bu code pdf print yapıyor. sonunda 0 byte bir dosya ortaya cikariyor.

Sizlerden ricam code 'u inceleyip otomatik save edecek sekilde duzelyebilir misiniz.

Simdi cok tesekkurler.

Option Explicit

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
Sheet1.Range("K9").Value = .SelectedItems(1)
End With
NoSelection:
End Sub
Sub SavePDFFolder()
Dim PDFFldr As FileDialog
Set PDFFldr = Application.FileDialog(msoFileDialogFolderPicker)
With PDFFldr
.Title = "Select a Folder"
If .Show <> -1 Then GoTo NoSel:
Sheet1.Range("K11").Value = .SelectedItems(1)
End With
NoSel:
End Sub

Sub CreatePDFForms()
Dim PDFTemplateFile, NewPDFName, SavePDFFolder, LastName As String
Dim SlNumber As Integer
Dim CustRow, LastRow As Long
With Sheet1
If .Range("K9").Value = Empty Or .Range("K11").Value = Empty Then
MsgBox "Both PDF Template and Saved PDF Locations are required for macro to run"
Exit Sub
End If

LastRow = .Range("E9999").End(xlUp).Row 'Last Row
PDFTemplateFile = .Range("K9").Value 'Template File Name
SavePDFFolder = .Range("K11").Value 'Save PDF Folder
ThisWorkbook.FollowHyperlink PDFTemplateFile
Application.Wait Now + 0.00006

For CustRow = 5 To 7 'LastRow
LastName = .Range("E" & CustRow).Value 'Last Name
SlNumber = .Range("D" & CustRow).Value 'Sl Number
Application.SendKeys "{Tab}", True
Application.SendKeys LastName, True
Application.Wait Now + 0.00003

Application.SendKeys "{Tab}", True
Application.SendKeys .Range("F" & CustRow).Value, True 'Position Title
Application.Wait Now + 0.00003

Application.SendKeys "^(p)", True
Application.Wait Now + 0.00007
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00007

If Dir(SavePDFFolder & "\" & LastName & "_" & SlNumber & ".pdf") <> Empty Then Kill (SavePDFFolder & "\" & LastName & "_" & SlNumber & ".pdf")
Application.SendKeys "%", True
Application.Wait Now + 0.00002
Application.SendKeys SavePDFFolder & "\" & LastName & "_" & SlNumber & ".pdf"
Application.Wait Now + 0.00004
Application.SendKeys "%(s)", True
Application.Wait Now + 0.00004
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00007
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00007


Next CustRow
Application.SendKeys "^(q)", True
Application.SendKeys "{Tab}", True
Application.SendKeys "{Enter}", True
Application.Wait Now + 0.00007
Application.SendKeys "{numlock}%s", True

End With
End Sub