Excel值为PDF表单字段

时间:2017-04-24 22:42:37

标签: forms excel-vba pdf vba excel

objJSO.GetField(strField).Value =(strFieldVal) - 这就是我收到类型不匹配的行'错误。 我找到了来自" My Engineering World"的代码库。这是一个老帖子。

我选择静态PDF表单并尝试将excel doc中的值写入包含相同字段名称的PDF表单。 excel doc在c20-149列中具有字段名称,其中包含d20-149中这些字段的值。我试图将这些字段的值写入选定的PDF表单。

Option Explicit

Sub btnToPDF_Click()

Dim objAcroApp As Object
Dim objAcroAVDoc As Object
Dim objAcroPDDoc As Object
Dim objJSO As Object
Dim fd As Office.FileDialog
Dim strFile As String
Dim strField As String
Dim strFieldVal As String 'Used to hold the field value
Dim r As Long 'Used to increase row number for strfield name

'Disable screen flickering.
    Application.ScreenUpdating = False

'Choose the Onsite Survey form you want to fill
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd

        .AllowMultiSelect = False

        .Title = "Please select the On-site survey PDF."
        .Filters.Clear
        .Filters.Add "PDF", "*.PDF"
        '.Filters.Add "All Files", "*.*"

    'If the .Show method returns False, the user clicked Cancel.
        If .Show = True Then
            strFile = .SelectedItems(1)
            MsgBox (strFile)
        End If
    End With

'Initialize Acrobat by creating the App object.
    Set objAcroApp = CreateObject("AcroExch.App")

'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "Could not create the App object!", vbCritical, "Object error"
        'Release the object and exit.
        Set objAcroApp = Nothing
        Exit Sub
    End If

'Create the AVDoc object.
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")

    'Check if the object was created.
        If Err.Number <> 0 Then
            MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
        'Release the objects and exit.
            Set objAcroAVDoc = Nothing
            Set objAcroApp = Nothing
            Exit Sub
        End If

    On Error GoTo 0

'Open the PDF file.
    If objAcroAVDoc.Open(strFile, "") = True Then

        'Set the PDDoc object.
            Set objAcroPDDoc = objAcroAVDoc.GetPDDoc

        'Set the JS Object - Java Script Object.
            Set objJSO = objAcroPDDoc.GetJSObject

            On Error GoTo 0

        'Fill the form fields.
            For r = 20 To 149
                strField = Cells(r, 3)
                strFieldVal = Cells(r, 4)

                objJSO.GetField(strField).Value = CStr(strFieldVal)


                If Err.Number <> 0 Then

                    'Close the form without saving the changes.
                    objAcroAVDoc.Close True

                    'Close the Acrobat application.
                    objAcroApp.Exit

                    'Inform the user about the error.
                    MsgBox "The field """ & strField & """ could not be found!", vbCritical, "Field error"

                    'Release the objects and exit.
                    Set objJSO = Nothing
                    Set objAcroPDDoc = Nothing
                    Set objAcroAVDoc = Nothing
                    Set objAcroApp = Nothing
                    Exit Sub

                End If
        Next r


    'Save the form
        objAcroPDDoc.Save 1, strFile

    'Close the form without saving the changes.
        'objAcroAVDoc.Close True


    'Close the Acrobat application.
        objAcroApp.Exit

    'Release the objects.
        Set objJSO = Nothing
        Set objAcroPDDoc = Nothing
        Set objAcroAVDoc = Nothing
        Set objAcroApp = Nothing



    'Enable the screen.
        Application.ScreenUpdating = True

    'Inform the user that forms were filled.
        MsgBox "All forms were created successfully!", vbInformation, "Finished"
End If
    MsgBox "Something bad happend :(...."

End Sub

3 个答案:

答案 0 :(得分:1)

好的......发现了我的问题,但我不确定如何解决问题。我可能不需要,因为我希望我不会遇到这个问题。希望不是最好的策略...... :) 我的PDF表单包含数字类型的字段。我的值单元格中的所有测试数据都是字母数字。一旦我将数量和费用单元格更改为我的Excel文档中的数值,表单就会正确写入 也许我可以测试PDF表单字段类型。如果是数字,我将记录字段名称,并在操作结束时显示一个msgbox,显示无法填充的字段。 我确实需要将我的objJSO行更正为'= strFieldVal'

答案 1 :(得分:0)

我很确定你想......

strField = Cells(r, 3).Value
strFieldVal = Cells(r, 4).Value
objJSO.GetField(strField).Value = strFieldVal

...而不是你拥有的三条相应的行。

答案 2 :(得分:0)

以下是我的最终代码。它包括基本的错误处理(更像是日志记录)。我在这方面遇到的一个问题;如果我在PDF字段中写入字母数字字符串,并且PDF字段是数字的,那么PDF将抛出的PDF字段中没有默认值,而且我的代码无法捕获错误。只要PDF数字字段中存在默认值,错误处理程序就会按计划运行。随意发表任何评论。我猜这看起来像幼儿园的工作(也许是一年级?) `Option Explicit

Sub btnToPDF_Click()

Dim objAcroApp As Object
Dim objAcroAVDoc As Object
Dim objAcroPDDoc As Object
Dim objJSO As Object
Dim fd As Office.FileDialog
Dim myWB As Workbook
Set myWB = ThisWorkbook
Dim ToPDFsh As Worksheet
Set ToPDFsh = myWB.Sheets("OSSDataDump")
Dim strFile As String
Dim strField As String
Dim strFieldVal As String 'Used to hold the field value
Dim msgFail As String
Dim colVal As Variant
Dim r As Integer 'Used to increase row number for strfield name
Dim e As Integer 'Used to track the number of errors
Dim colFail As Collection
Set colFail = New Collection
e = 0


'Disable screen flickering.
    Application.ScreenUpdating = False

'Choose the Onsite Survey form you want to fill
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd

        .AllowMultiSelect = False

        .Title = "Please select the On-site survey PDF."
        .Filters.Clear
        .Filters.Add "PDF", "*.PDF"


    'If the .Show method returns False, the user clicked Cancel.
        If .Show = True Then
            strFile = .SelectedItems(1)

        End If
    End With

'Initialize Acrobat by creating the App object.
    Set objAcroApp = CreateObject("AcroExch.App")

'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "Could not create the App object!", vbCritical, "Object error"
        'Release the object and exit.
        Set objAcroApp = Nothing
        Exit Sub
    End If


'Create the AVDoc object.
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")

    'Check if the object was created.
        If Err.Number <> 0 Then
            MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
        'Release the objects and exit.
            Set objAcroAVDoc = Nothing
            Set objAcroApp = Nothing
            Exit Sub
        End If


'Open the PDF file.
    If objAcroAVDoc.Open(strFile, "") = True Then

        'Set the PDDoc object.
            Set objAcroPDDoc = objAcroAVDoc.GetPDDoc

        'Set the JS Object - Java Script Object.
            Set objJSO = objAcroPDDoc.GetJSObject


        'Fill the form fields.
            For r = 20 To 149
                strField = ToPDFsh.Cells(r, 3).Value
                strFieldVal = ToPDFsh.Cells(r, 4).Value
                    If strFieldVal = "" Then GoTo BlankVal

                objJSO.GetField(strField).Value = strFieldVal

                On Error GoTo ErrHandler

BlankVal:                 下一个r

    'Save the form
        objAcroPDDoc.Save 1, strFile

    'Close the form without saving the changes.
        'objAcroAVDoc.Close True


    'Close the Acrobat application.
        objAcroApp.Exit

    'Release the objects.
        Set objJSO = Nothing
        Set objAcroPDDoc = Nothing
        Set objAcroAVDoc = Nothing
        Set objAcroApp = Nothing



    'Enable the screen.
        Application.ScreenUpdating = True

    'Inform the user that forms were filled.
        If e <> 0 Then
            For Each colVal In colFail
                msgFail = msgFail & colVal & vbNewLine
            Next colVal

            MsgBox "Not all fields were filled" & vbNewLine & "The follwoing fields failed:" & vbNewLine & msgFail, vbExclamation, "Finished"
        Exit Sub
        End If
        MsgBox "On site survey was filled successfully!", vbInformation, "Finished"
End If
Exit Sub

ErrHandler:     e = e + 1     如果e> 7然后         MsgBox“发生了一件坏事... :(”&amp; vbNewLine&amp;“Form not filled”,vbCritical,“失败”         GoTo ErrHandlerExit     结束如果

colFail.Add strField
Resume Next
Exit Sub

ErrHandlerExit:     '关闭表单而不保存更改。     objAcroAVDoc.Close True

'Close the Acrobat application.
objAcroApp.Exit

'Release the objects and exit.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing

'Enable the screen.
Application.ScreenUpdating = True
Exit Sub

结束Sub`