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

Question

私は請求シートを作成するセラピストです。首に痛みがあり、ひとつずつ書き出すので、自分のニーズに合わせて修正したマクロがあります。これは、Excelファイルを取り、PDFファイルを自動完成させるFDFファイルを作成します。私がする必要があるのは、Excelファイルを記入するだけで、PDFファイルを自動生成できます。

問題は、クライアントが3人、5人、7人になることがあるということです。シートに指定する番号のマクロを作成し、その量のクライアント用にFDFを作成します。

私は8つのPDFファイルを持っています。 Billing1、Billin2など。シート内の数値に基づいて、Client1 Date1 Client2 Date2などの値を埋め込むFDFファイルを作成するマクロを作成します。現在、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

が続い

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