Acrobat PDF Formularfelder mit Excel ausfüllen

Public Sub Fill_PDF_Form()



Dim saveok

    Dim gApp As Acrobat.CAcroApp

    Dim AvDoc As Acrobat.CAcroAVDoc

    Dim gPDDoc As Acrobat.CAcroPDDoc

    Dim DOC_FOLDER

    Dim x As Boolean

    Dim sDoc As Object

    DOC_FOLDER = ActiveWorkbook.Path

    Set gApp = CreateObject("AcroExch.App")

    Set gPDDoc = CreateObject("AcroExch.PDDoc")

    Set AvDoc = CreateObject("AcroExch.AVDoc")

    Dim FormApp As AFORMAUTLib.AFormApp

    Dim AcroForm As AFORMAUTLib.Fields

    Dim Field As AFORMAUTLib.Field

    x = AvDoc.Open(DOC_FOLDER & "\Palettenzettel.pdf", "")

    Set FormApp = CreateObject("AFormAut.App")

    Dim letztezeile As Integer

    

    letztezeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    

    Dim Ord  As String

    Ord = ActiveWorkbook.Path & "\Export"

    If Dir(Ord, vbDirectory) = "" Then MkDir Ord

    Ord = Ord & "\Export"

    

    

    'Schleife

    Dim i As Long

    For i = 2 To letztezeile

     

    With FormApp

        .Fields("AuftragsNr").Value = Sheets(1).Cells(i, 1)

        .Fields("holzhaltig").Value = Sheets(1).Cells(i, 2)

        .Fields("holzfrei").Value = Sheets(1).Cells(i, 3)

        .Fields("Kunde").Value = Sheets(1).Cells(i, 4)

        .Fields("Objekt").Value = Sheets(1).Cells(i, 5)

        .Fields("Form").Value = Sheets(1).Cells(i, 6)

        .Fields("Lieferschein-Nr").Value = Sheets(1).Cells(i, 7)

        .Fields("Auflage").Value = Sheets(1).Cells(i, 8)

        .Fields("Soll").Value = Sheets(1).Cells(i, 9)

        .Fields("Ist").Value = Sheets(1).Cells(i, 10)

        .Fields("Paletten-Nr").Value = Sheets(1).Cells(i, 11)

        .Fields("Paletten-Nr-Gesamt").Value = Sheets(1).Cells(i, 12)

        .Fields("Datum").Value = Sheets(1).Cells(i, 13)

        '...

    End With

    AvDoc.PrintPages 0, 1, 2, 1, 1

    Set sDoc = AvDoc.GetPDDoc

    'saveok = sDoc.Save(1, DOC_FOLDER & "\Palettenzettel" & "_" & Sheets(1).Cells(i, 1) & "_F" & Sheets(1).Cells(i, 6) & "_L" & Sheets(1).Cells(i, 7) & "_Pal" & Sheets(1).Cells(i, 11) & ".pdf")

    saveok = sDoc.Save(1, ActiveWorkbook.Path & "\Export" & "\Palettenzettel" & "_" & Sheets(1).Cells(i, 1) & "_F" & Sheets(1).Cells(i, 6) & "_L" & Sheets(1).Cells(i, 7) & "_Pal" & Sheets(1).Cells(i, 11) & ".pdf")

    Next

    AvDoc.Close (1)

    gApp.Exit

    

    



End Sub