Excel VBA使用variables写入FDF文件
我是一名治疗师，他必须编写帐单。 把它们一个接一个地写出来是一件痛苦的事情，所以我有一个macros，我修改，以适应我的需要。 它需要一个Excel文件，并写入一个FDF文件，然后自动填充PDF文件。 我需要做的就是填写excel文件，它可以自动生成PDF文件。
我遇到的麻烦是有时候我有3个客户端，或者5个，或者7个。我想写一个macros，它会在表中指定一个数字，并为这个数量的客户端创build一个FDF。
所以我会有8个PDF文件。 Billing1，Billin2等等。根据工作表中的编号，我希望macros创build一个填充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 使用循环
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