Excel Forum

Code: Select all

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                      (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
                                       ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
                                       
                                       
Sub PrintPDFToSpecificPrinter(Filename As String)
    ShellExecute Application.hwnd, "print", Filename, vbNullString, vbNullString, 0&
End Sub



Sub WriteAdobeFields()

    Dim AcrobatApplication As Acrobat.CAcroApp
    Dim AcrobatDocument As Acrobat.CAcroAVDoc
    Dim AcrobatPDocument As Acrobat.AcroPDDoc
    Dim fcount As Long
    Dim sFieldName As String
    
    Set AcrobatApplication = CreateObject("AcroExch.App")
    Set AcrobatDocument = CreateObject("AcroExch.AVDoc")
    Set AcrobatPDocument = AcrobatDocument.GetPDDoc
    
    
    xRowCount = Sheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row 'จำนวนแถวข้อมูล
    
    
        If AcrobatDocument.Open("D:\PrintIDTest\template.pdf", "") Then
            AcrobatApplication.Show
            Set AcroForm = CreateObject("AFormAut.App")
            Set Fields = AcroForm.Fields
            fcount = Fields.Count ' Number of Fields
            
            x = 1
            Do While x < xRowCount
                ValuesID = Cells(x + 1, 2).Value 'รับค่าจาก cell
                Fields("ValueID").Value = ValuesID 'เติมค่าลงใน Field

                AcrobatPDocument.Save ("D:\PrintIDTest\template.pdf") 'save ไฟล์ก่อนปริ้น
                
                PrintPDFToSpecificPrinter ("D:\PrintIDTest\template.pdf") 'ปริ้น
                
                x = x + 1
            Loop
            
        

        Else
            MsgBox "ไม่สามารถเปิดไฟล์ได้"
        
        End If
     
        
    

    
    
    AcrobatApplication.Exit
    Set AcrobatApplication = Nothing
    Set AcrobatDocument = Nothing
    Set Field = Nothing
    Set Fields = Nothing
    Set ActoForm = Nothing


    
End Sub

Code: Select all

Sub PrintDocs()
    Dim r As Range
    With Worksheets("Sheet1")
        For Each r In .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
            .Range("p2:q2").Value = r.Resize(1, 2).Value
            .PrintOut 'Or save as to target file name
        Next r
    End With
End Sub