Excel VBA 使用变量写入 FDF 文件

Question

我是一名治疗师，必须写账单 sheets。将它们一个一个地写出来是一件令人头疼的事情，所以我修改了一个宏来满足我的需要。它需要一个 excel 文件并写入一个 FDF 文件，然后自动填充一个 PDF 文件。我需要做的就是填写 excel 文件，它可以自动生成 PDF 文件。

我遇到的麻烦是有时我有 3 个客户端，或 5 个，或 7 个。我想编写一个宏，它采用将在 sheet 中指定的数字，并为那个数量的客户。

所以我将有 8 个 PDF 文件。 Billing1、Billin2 等。根据 sheet 中的数字，我希望宏创建一个 FDF 文件来填充 Client1 Date1 Client2 Date2 等的值。现在它只设置为一次处理 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

Excel VBA 使用变量写入 FDF 文件

Excel VBA Write FDF file using Variables

macros

excel

vba

fdf