Excel VBA使用變量寫入FDF文件

Question

我是一名治療師，他必須編寫賬單。把它們逐個寫出來是一件痛苦的事情，所以我有一個宏，我修改了它來滿足我的需要。它需要一個excel文件並寫入一個FDF文件，然後自動填充PDF文件。我需要做的就是填寫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

使用循環

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