Question

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

Option Explicit

私有声明函数ShellExecute Lib“shell32.dll”别名“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 公共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错误：”+ 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

从FDF文件保存并打印PDF

1 个答案: