【问题标题】:Export data from Excel to pdf form without saving it as .csv or other file first将数据从 Excel 导出为 pdf 表单,无需先将其保存为 .csv 或其他文件
【发布时间】:2018-04-29 05:08:06
【问题描述】:

我有一个非常复杂的 Excel 工作簿,我的老板希望在其中一个工作表上将一些值放在 Acrobat 表单中。

我能够找到并编辑一个宏(我找到了here),它会打开一个空白版本的表单。

我被要求找到一种方法,然后让 Acrobat 模板中的表单字段从 Excel 工作表中的匹配标题自动填充(前提是填写一个字段作为起点),但 没有 将 Excel 工作表保存为 .csv 以制表符或其他任何间歇步骤。

或者,相反地,在 Excel 工作表中创建一个宏,该宏将从例如当前行中获取值并打开,然后填写 Acrobat 表单。

这在 Excel 或 Acrobat Pro 中是否可行?

我对java和Visual Basic不太了解,请耐心等待。

您能提供的任何帮助将不胜感激。

谢谢。

【问题讨论】:

标签: vba excel acrobat


【解决方案1】:

您可以创建一个 UTF-8 XML 文本文件并将其轻松导入 PDF。 这是我编写的用于创建 XML 文件的函数。

该函数创建一个XFDX,在文件头中,指定了PDF文件。

您只需双击 XFDX 文件,adobe reader 就会导入数据。

Private Function CreatePDFFile(PDFileID As Integer) As Boolean
Dim sFileHeader As String
Dim sFileFooter As String
Dim sFileFields As String
Dim sTmp As String
Dim sFileName As String
Dim lngFileNum As Long
Dim FieldName, FieldValue As String
Dim row, PDFRowStart, PDFRowEnd, PDFNumberOfRows, RetVal As Integer
Dim doc As New MSXML2.DOMDocument60
On Error GoTo ErrorHandler_CreatePDFFile
    
    'If errors then Use late binding to avoid error user-defined type not defined (References)
    'Dim doc As Variant
    'Set doc = CreateObject("MSXML2.DOMDocument")
    
    If Len(PDFFilePath(PDFileID)) < 1 Then
       ' MsgBox "Wählen Sie zuerst eine Datei aus. Für diese  PDF-Datei-ID: " & PDFileID
       'If no file selected for this PDFFile ID then do nothing...
       CreatePDFFile = False
        Exit Function
    Else
        'Continue to create list of selected PDF docs further here in this sub.
        CreatePDFFile = True
    End If
    
    'Locaion of PDF File
    'PDFFile1Path
    'sFileName = "D:\OneDrive\PDF\Try6\" & "NameOfPDFFile.pdf"
    'Adobe, use this path to open the correct PDF to import the data into.
    Dim temp As String
    temp = PDFFilePath(PDFileID) '& "\" & PDFFileName(PDFileID)
    
    sFileHeader = "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf & _
                  "<xfdf xmlns=""http://ns.adobe.com/xfdf/"" xml:space=""preserve"">" & vbCrLf & _
                  "     <f href=""" & temp & """/>" & vbCrLf & _
                  "     <fields>" & vbCrLf

    sFileFooter = "    </fields>" & vbCrLf & _
                  "    <ids original=""31686985C2863CD11CFF58ED2604C831"" modified=""6592384A5ED5A44484C99A887E1D71CE""/>" & vbCrLf & _
                  "</xfdf>"
    
    'Example XML field value pair
    ' sFileFields = "     <field name=""ClientName"">" & vbCrLf & _
    '               "         <value>Firstname Lastname</value>" & vbCrLf & _
    '               "     </field>" & vbCrLf
    

    'Determine the start for of data in Excel for this file
    'Start row is marked with a nammed called cell PDFFile1StartRow
    If Not NamedRangeExists(ActiveWorkbook.Names, "PDFFile" & PDFileID & "StartRow") Then
        MsgBox "Remember to define the start row named cell! " & "PDFFile" & PDFileID & "StartRow"
        Exit Function
    Else
        'Set the PDFRowStart to the row number of the named field found
        PDFRowStart = Range("PDFFile" & PDFileID & "StartRow").row
    End If
    
    'Determine the end row for of data in Excel for this file
    'Strat end is marked with a nammed cell called PDFFile1EndRow
    If Not NamedRangeExists(ActiveWorkbook.Names, "PDFFile" & PDFileID & "EndRow") Then
        MsgBox "Remember to define the end row named cell! " & "PDFFile" & PDFileID & "EndRow"
        Exit Function
    Else
        'Set the PDFRowEnd to the row number of the named field found
        PDFRowEnd = Range("PDFFile" & PDFileID & "EndRow").row
    End If
    
    'How many rows of data are there for this file to loop through?
    PDFNumberOfRows = PDFRowEnd - PDFRowStart
        
    'Loop through all the rows of data for this specific PDF file, and create a new xml field for each row.
    For row = PDFRowStart To PDFRowStart + PDFNumberOfRows
        
        On Error GoTo ErrorHandler_CreatePDFFile
        'The first column contains the name of the field in the PDF document, the second column the value
        FieldName = Worksheets("PDF").Cells(row, 1).value
        FieldValue = Worksheets("PDF").Cells(row, 2).value

        'Encode text to xml, encode special characters like ampersands.
        FieldName = doc.createTextNode(FieldName).XML
        FieldValue = doc.createTextNode(FieldValue).XML

        'Add a new field node in the xml document.
        sFileFields = sFileFields & "     <field name=""" & FieldName & """>" & vbCrLf & _
                        "         <value>" & FieldValue & "</value>" & vbCrLf & _
                        "     </field>" & vbCrLf
    Next row
    
    'Combine the header content and footer to create the complete XML File
    sTmp = sFileHeader & sFileFields & sFileFooter
    'Debug.Print sTmp
    
    ' Set the path of the XML file to be written disk
    'sFileName = ActiveWorkbook.Path & "\" & PDFFileName(PDFileID) & ".xfdf"
    'save it to the same path as the PDF file,just change the extension to . xfdf
    sFileName = PDFFilePath(PDFileID) & ".xfdf"
    
    'Load the xml text into the MSXML2.DOMDocument60, and parse it to see if valid
    doc.LoadXML (sTmp)
    
    If doc.parseError <> 0 Then
        MsgBox "0x" & Hex(doc.parseError) & ": " & doc.parseError.reason
        Exit Function
    End If

    'Save the XML file to disk in utf-8 file format
    doc.Save (sFileName)
    
    'Destroy the object, release the file to be deleted.
    Set doc = Nothing
    
    DoEvents
        
    'Wait one second to give it time to save the file completely
    Application.Wait Now + #12:00:03 AM#
       
    ' Open XFDX file as PDF
    OpenXMLFile (sFileName)
    
    DoEvents
    
    Exit Function

ErrorHandler_CreatePDFFile:
    
    If Err.Number = 13 Then
            MsgBox "Error number: " & Err.Number & " Description: " & Err.Description & " Error in data in row: " & row
        Exit Function
    End If
    MsgBox "Make xfdf Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source
End Function

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-12-11
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2023-03-27
    相关资源
    最近更新 更多