2

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

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

所以我将有 8 个 PDF 文件。Billing1、Billin2 等。根据工作表中的数字，我希望宏创建一个 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
4

1 回答 1

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
于 2016-05-26T17:03:09.127 回答