Option Explicit
Sub Xuat_PDF()
'On Error Resume Next
Dim i%, j%, FileName$
Dim PdfFile As String, Arr
PdfFile = ThisWorkbook.Path
If Right(PdfFile, 1) <> "\" Then PdfFile = PdfFile & "\"
Arr = Sheet1.Range("B2:H" & Sheet1.Range("B65000").End(xlUp).Row).Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Sheet2
.PageSetup.PrintArea = .Range("A1:B11").Address
For i = 1 To UBound(Arr)
FileName = PdfFile & Arr(i, 1) & ".pdf"
For j = 1 To 7
.Range("B" & (j + 4)).Value = Arr(i, j)
Next j
'.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Call PdfPwd(Sheet2, FileName, "GPE")
Next i
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Da xuat sang PDF xong"
End Sub
'Truoc het phai tai phan mem nay ve may
'Download PDFtk Free : https://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/
Sub PdfPwd(sh As Worksheet, oPdf As String, Pwd As String)
Dim fTemp As String, cmdStr As String 'Defining Variables
fTemp = Environ("Temp") & "\" & "Temp.Pdf"
sh.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fTemp, Quality:=xlQualityStandard
fTemp = """" & fTemp & """" 'Putting extra "" around for command Parameter.
oPdf = """" & oPdf & """"
Pwd = """" & Pwd & """"
'Making Command String for making protected PDFs Using PDFtk tool.
cmdStr = "pdftk " & fTemp _
& " Output " & oPdf _
& " User_pw " & Pwd _
& " Allow AllFeatures"
Shell cmdStr, vbHide 'Executing PDFtk Command.
Application.Wait DateAdd("s", 2, Now) 'Allowing 2 secs for command to execute.
Kill Replace(fTemp, """", "") 'Deleting temporary files.
End Sub
