I'm a therapist who has to write billing sheets. It's a pain in the neck to write them out one by one, so I have a macro that I modified to suit my needs. It takes an excel file and writes an FDF file which then autofills a PDF file. All I need to do is fill out the excel file and it can autogenerate the PDF file.
The trouble I have is that sometimes I have 3 clients, or 5, or 7. I want to write a macro that takes a number that will be specified in the sheet, and create an FDF for that amount of clients.
So I will have 8 PDF files. Billing1, Billin2, etc. Based on the number in the sheet, I want the macro to create an FDF file filling the values of Client1 Date1 Client2 Date2, etc. Right now it's only set up to do 6 clients at once and it's static.
Here is the code I have now:
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
Use a loop
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
Then
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