vba - Excel VBA変数を使用してFDFファイルを書き込む

Question

私は請求書を書かなければならないセラピストです。それらを一つ一つ書き出すのは大変なので、自分のニーズに合わせて修正したマクロがあります。それは、Excel ファイルを受け取り、PDF ファイルを自動入力する FDF ファイルを書き込みます。Excel ファイルに入力するだけで、PDF ファイルが自動生成されます。

問題は、クライアントが 3 つ、または 5 つ、または 7 つある場合があることです。シートで指定される数を受け取るマクロを作成し、その数のクライアントの FDF を作成したいと考えています。

したがって、8つのPDFファイルがあります。Billing1、Billin2 など。シートの数値に基づいて、マクロで Client1 Date1 Client2 Date2 などの値を入力する FDF ファイルを作成する必要があります。

ここに私が今持っているコードがあります:

    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