Snasui Excel Forum

Code: Select all

Sub Run_Save_Pdf()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Dim i As Integer
Dim a As Integer
Dim v As Integer

Set wbA = ActiveWorkbook
Set wsA = Sheets("FORM")

On Error Resume Next
v = InputBox( _
        Title:="ระบุฉบับที่เริ่ม", _
        prompt:="กรอกหมายเลขฉบับเริ่มพิมพ์")

a = InputBox( _
        Title:="ระบุฉบับที่สิ้นสุด", _
        prompt:="กรอกหมายเลขฉบับสุดท้ายที่ต้องการพิมพ์")
If Err = 13 Then
    MsgBox "โปรดกรอกข้อมูลฉบับที่เริ่มและสิ้นสุด"
    Exit Sub
End If

For i = v To a
     Range("AY4") = i
'get active workbook folder, if saved
strPath = wbA.path

If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
strTime = Format(Now(), "yyyymmdd")
'create default name for savng file
strFile = strName & Range("AY4") & ".pdf"
strPathFile = strPath & strFile
'export to PDF in current folder
    wsA.ExportAsFixedFormat Type:=xlTypePDF, FileName:=strPathFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
         Next i
    ''''confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf & strPath
''      & strPathFile
exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
[attachment=0]Form_Update_2018.xlsm[/attachment]