Excel VBA 使用变量写入 FDF 文件

Question

我是一名治疗师，必须写账单表。将它们一一写出来很痛苦，所以我有一个宏，我修改了它以满足我的需求。它需要一个 excel 文件并写入一个 FDF 文件，然后自动填充一个 PDF 文件。我需要做的就是填写 excel 文件，它可以自动生成 PDF 文件。

我

遇到的问题是有时我有 3 个客户，或 5 个或 7 个。我想编写一个宏，该宏采用将在工作表中指定的数字，并为该数量的客户端创建一个 FDF。

所以我会有 8 个 PDF 文件。Billing1、Billin2等根据工作表中的数字，我希望宏创建一个 FDF 文件，填充客户端 1 日期 1 客户端 2 日期 2 等的值。现在它只设置为一次执行 6 个客户端，并且是静态的。

这是我现在的代码：

    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 = "Billing.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(Date1)/V(---Date1---)>>" & vbCrLf & _
                  "<</T(Date2)/V(---Date2---)>>" & vbCrLf & _
                  "<</T(Date3)/V(---Date3---)>>" & vbCrLf & _
                  "<</T(Date4)/V(---Date4---)>>" & vbCrLf & _
                  "<</T(Date5)/V(---Date5---)>>" & vbCrLf & _
                  "<</T(Date6)/V(---Date6---)>>" & vbCrLf & _
                  "<</T(Name1)/V(---Name1---)>>" & vbCrLf & _
                  "<</T(Name2)/V(---Name2---)>>" & vbCrLf & _
                  "<</T(Name3)/V(---Name3---)>>" & vbCrLf & _
                  "<</T(Name4)/V(---Name4---)>>" & vbCrLf & _
                  "<</T(Name5)/V(---Name5---)>>" & vbCrLf & _
                  "<</T(Name6)/V(---Name6---)>>" & vbCrLf
    Range("A5").Select
    vClient = Range(Selection.Row & ":" & Selection.Row)
    sFileFields = Replace(sFileFields, "---Date1---", vClient(1, 9))
    sFileFields = Replace(sFileFields, "---Date2---", vClient(1, 10))
    sFileFields = Replace(sFileFields, "---Date3---", vClient(1, 11))
    sFileFields = Replace(sFileFields, "---Date4---", vClient(1, 12))
    sFileFields = Replace(sFileFields, "---Date5---", vClient(1, 13))
    sFileFields = Replace(sFileFields, "---Date6---", vClient(1, 14))
    sFileFields = Replace(sFileFields, "---Name1---", vClient(1, 15))
    sFileFields = Replace(sFileFields, "---Name2---", vClient(1, 16))
    sFileFields = Replace(sFileFields, "---Name3---", vClient(1, 17))
    sFileFields = Replace(sFileFields, "---Name4---", vClient(1, 18))
    sFileFields = Replace(sFileFields, "---Name5---", vClient(1, 19))
    sFileFields = Replace(sFileFields, "---Name6---", vClient(1, 20))
    sTmp = sFileHeader & sFileFields & sFileFooter

    ' Write FDF file to disk
    sFileName = "BillingMultipule"
    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

使用循环

Dim iFields as Integer
For iFields = 1 to Worksheets("Sheet1").Range("A5").Value2 'assumes this is where you have number of clients.
   sFileFieldDates = sFileFieldDates & "<</T(Date" & iFields & ")/V(---Date" & iFields & "---)>>" & vbCrLf
   sFileFieldNames = sFileFieldNames & "<</T(Name" & iFields & ")/V(---Name" & iFields & "---)>>" & vbCrLf
Next 
'you most likely need to use Mid or Trim or something to get rid of extra spacing or characters before combining the names
sFileFields = sFileFieldDates & sFileFieldNames

然后

For iFields = 1 to Worksheets("Sheet1").Range("A5").Value2
   sFileFields = Replace(sFileFields, "---Date" & iFields & "---", vClient(1, iFields +9))
   sFileFields = Replace(sFileFields, "---Name" & iFields & "---", vClient(1, iFields +15))
Next