从 FDF 文件保存和打印 PDF

Question

我有以下宏将数据从 excel 填充到 PDF。我想增强代码以保存 PDF 并打印它。该文件的名称位于单元格 A5 中。当前代码将 FDF 保存到我的目录中。以下是使用的代码，取自以下链接：http://blog.excelhero.com/2010/04/14/excel_acrobat_pdf_form_filler/:

Option Explicit
Private Declare 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
Private Const SW_NORMAL = 1
Public Const PDF_FILE = "f8655.pdf"


Public Sub MakeFDF()

    Dim sFileHeader As String
    Dim sFileFooter As String
    Dim sFileFields As String
    Dim sFileName As String
    Dim sTmp As String
    Dim lngFileNum As Long
    Dim vClient As Variant
    
    
    ' Builds string for contents of FDF file and then writes file to workbook folder.
    On Error GoTo ErrorHandler
    
    sFileHeader = "%FDF-1.2" & vbCrLf & _
                  "%âãÏÓ" & vbCrLf & _
                  "1 0 obj<</FDF<</F(" & PDF_FILE & ")/Fields 2 0 R>>>>" & vbCrLf & _
                  "endobj" & vbCrLf & _
                  "2 0 obj[" & vbCrLf
                  
    sFileFooter = "]" & vbCrLf & _
                  "endobj" & vbCrLf & _
                  "trailer" & vbCrLf & _
                  "<</Root 1 0 R>>" & vbCrLf & _
                  "%%EO"
    

    sFileFields = "<</T(f1_01(0))/V(---NAME---)>>" & vbCrLf & _
                  "<</T(f1_02(0))/V(---EIN_LEFT---)>>" & vbCrLf & _
                  "<</T(f1_03(0))/V(---EIN_RIGHT---)>>" & vbCrLf & _
                  "<</T(f1_06(0))/V(---OIN---)>>" & vbCrLf & _
                  "<</T(f1_04(0))/V(---TRADE_NAME---)>>" & vbCrLf & _
                   "<</T(c1_1(0))/V(---SEASONAL---)>>" & vbCrLf & _
                  "<</T(f1_05(0))/V(---STREET_ADDRESS---)>>" & vbCrLf & _
                  "<</T(f1_07(0))/V(---CITY_STATE_ZIP---)>>" & vbCrLf & _
                  "<</T(f1_08(0))/V(---CONTACT---)>>" & vbCrLf & _
                  "<</T(f1_09(0))/V(---PHONE_LEFT---)>>" & vbCrLf & _
                  "<</T(f1_10(0))/V(---PHONE_RIGHT---)>>" & vbCrLf & _
                  "<</T(f1_11(0))/V(---FAX_LEFT---)>>" & vbCrLf & _
                  "<</T(f1_12(0))/V(---FAX_RIGHT---)>>" & vbCrLf
    
    
    vClient = Range(Selection.Row & ":" & Selection.Row)
    
    sFileFields = Replace(sFileFields, "---NAME---", vClient(1, 2))
    If Len(vClient(1, 3)) > 3 Then
        sTmp = Replace(vClient(1, 3), "-", "")
        sFileFields = Replace(sFileFields, "---EIN_LEFT---", Left$(sTmp, 2))
        sFileFields = Replace(sFileFields, "---EIN_RIGHT---", Mid$(sTmp, 3))
    Else
        sFileFields = Replace(sFileFields, "---EIN_LEFT---", vbNullString)
        sFileFields = Replace(sFileFields, "---EIN_RIGHT---", vbNullString)
    End If
    sFileFields = Replace(sFileFields, "---OIN---", vClient(1, 4))
    sFileFields = Replace(sFileFields, "---TRADE_NAME---", vClient(1, 5))
    sFileFields = Replace(sFileFields, "---SEASONAL---", vClient(1, 6))
    sFileFields = Replace(sFileFields, "---STREET_ADDRESS---", vClient(1, 7))
    sFileFields = Replace(sFileFields, "---CITY_STATE_ZIP---", vClient(1, 8))
    sFileFields = Replace(sFileFields, "---CONTACT---", vClient(1, 9))
    If Len(vClient(1, 10)) = 10 Then
        sTmp = Replace(vClient(1, 10), "-", "")
        sFileFields = Replace(sFileFields, "---PHONE_LEFT---", Left$(sTmp, 3))
        sFileFields = Replace(sFileFields, "---PHONE_RIGHT---", Mid$(sTmp, 4, 3) & "-" & Mid$(sTmp, 7))
    Else
        sFileFields = Replace(sFileFields, "---PHONE_LEFT---", vbNullString)
        sFileFields = Replace(sFileFields, "---PHONE_RIGHT---", vbNullString)
    End If
    If Len(vClient(1, 11)) = 10 Then
        sTmp = Replace(vClient(1, 11), "-", "")
        sFileFields = Replace(sFileFields, "---FAX_LEFT---", Left$(sTmp, 3))
        sFileFields = Replace(sFileFields, "---FAX_RIGHT---", Mid$(sTmp, 4, 3) & "-" & Mid$(sTmp, 7))
    Else
        sFileFields = Replace(sFileFields, "---FAX_LEFT---", vbNullString)
        sFileFields = Replace(sFileFields, "---FAX_RIGHT---", vbNullString)
    End If

    sTmp = sFileHeader & sFileFields & sFileFooter
    
    
    ' Write FDF file to disk
    If Len(vClient(1, 1)) Then sFileName = vClient(1, 1) Else sFileName = "FDF_DEMO"
    sFileName = ActiveWorkbook.Path & "\" & sFileName & ".fdf"
    lngFileNum = FreeFile
    Open sFileName For Output As lngFileNum
    Print #lngFileNum, sTmp
    Close #lngFileNum
    DoEvents
    
    ' Open FDF file as PDF
    ShellExecute vbNull, "open", sFileName, vbNull, vbNull, SW_NORMAL
    Exit Sub

ErrorHandler:
    MsgBox "MakeFDF Error: " + Str(Err.Number) + " " + Err.Description + " " + Err.Source

End Sub

任何帮助将不胜感激！

Answer 1

Option Explicit 

Declare Function apiShellExecute 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 

Public Sub PrintFile(ByVal strPathAndFilename As String) 
    Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0)  
End Sub 

Sub Test() 
    PrintFile ("C:\Test.pdf") 
End Sub 

按原样添加此代码，只需在您想要的位置调用 PrintFile 并在您的情况下传递您的文件路径 sFileName ，因此最终调用将是： PrintFile sFileName