将数据从Excel导出为pdf格式,而不将其另存为.csv或其他文件

时间:2017-11-15 20:16:36

标签: excel vba excel-vba acrobat

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

我能够找到并编辑一个可以打开表单空白版本的宏(我发现here)。

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

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

这可以在Excel或Acrobat Pro中执行吗?

我不太了解java或Visual Basic,所以请耐心等待。

非常感谢您提供的任何帮助。

谢谢。

1 个答案:

答案 0 :(得分:0)

您可以创建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