[Mitch Youngs]

Honestly I run all of my macros from an add in I made so none of my excel documents are macro-enabled. I’m trying to make work in a zip folder to upload here so that you can open and run it without changing a bunch of code. For now here is the code that i think has all of what you would need to reference and the template pdf but i’ll upload something better in a bit.

Field-Note-Record-Grid-4-22.pdf 1 MB PDF - Click to view

Options

• Copy Download Link

Excel2Pdf.txt 21 KB Text File - Click to view

Options

• Copy Download Link

Public Sub MakeFDF() Dim TurnOn As Boolean If Application.ScreenUpdating = True Then 'Turn off screen updating to make it faster Call Update_off TurnOn = True Else: TurnOn = False End If Dim sFileHeader As String Dim sFileFooter As String Dim sFileFields, sFileFieldItem, sFileFieldMaterial, sFileFieldProduct, sFileFieldManufacture, sFileFieldRAM, sFileFieldRamCode As String Dim sFileName As String Dim sTmp As String Dim lngFileNum As Long Dim lrow As ListRow Dim BidNum, Qty, Unit, BidItem, Product, Manufacturer, Acceptance, RamNo, AppCode, PayItem As String Dim FNRSavePath, FNRSaveFile, PDFTemplateFile, fdfName As String Dim ItemRow, lastrow, LastRow2 As Long 'Define where data you are going to use to fill out PDF forms Dim Contract_No, Project_Name, Project_No As String Contract_No = Worksheets("Rom").Range("L5").Value Project_Name = Worksheets("Rom").Range("G5").Value Project_No = Worksheets("Rom").Range("L6").Value Dim tblRom As ListObject 'I used a Table for most of my data Set tblRom = Worksheets("Rom").ListObjects("ROM") lastrow = tblRom.DataBodyRange.Rows.Count 'Last Row 'LastRow2 = Worksheets("Rom").Range("A9999").End(xlUp).Row 'Last Row without referencing table PDFTemplateFile = "P:\Public Works\01 Administration\FORMS\04 Construction\08 Inspection Docs\Field Note Record-Grid 4-22.pdf" 'Template File Name and location 'setting default save path for pdfs and check if folder exist with browsing for location as a pop up if location does not work FNRSavePath = ThisWorkbook.Path ChDrive "P" ChDir FNRSavePath ChDir ".." FNRSavePath = CurDir ChDir ".." FNRSavePath = CurDir FNRSavePath = FNRSavePath & "\05 Inspector Documents\02 Field Note Records\DATA" FNRSavePath = CheckFolderExists(FNRSavePath, " Inspector Documents FNR DATA ") ' this will be what shows in pop up to browse for a folder location If FNRSavePath = "" Then Exit Sub End If 'setting up counters to deal with looping through Dim counter, counter2, endnumber, iFields, pagecount, i As Integer endnumber = 9 counter = 1 counter2 = 1 iFields = 1 pagecount = 0 For Each lrow In tblRom.ListRows BidNum = Intersect(lrow.Range, tblRom.ListColumns("Bid Item").Range).Value Qty = Intersect(lrow.Range, tblRom.ListColumns("Item Qty.").Range).Value Unit = Intersect(lrow.Range, tblRom.ListColumns("Unit").Range).Value BidItem = Intersect(lrow.Range, tblRom.ListColumns("Material").Range).Value Product = Intersect(lrow.Range, tblRom.ListColumns("Product").Range).Value Manufacturer = Intersect(lrow.Range, tblRom.ListColumns("Manufacturer").Range).Value Acceptance = Intersect(lrow.Range, tblRom.ListColumns("Acceptance").Range).Value 'Spec = Intersect(lrow.Range, tblRom.ListColumns("Specification Section").Range).Value ' not needed column RamNo = Intersect(lrow.Range, tblRom.ListColumns("RAM No.").Range).Value AppCode = Intersect(lrow.Range, tblRom.ListColumns("RAM/QPL Approval Code").Range).Value If Intersect(lrow.Range, tblRom.ListColumns("Bid Item").Range).Interior.Color = RGB(214, 133, 255) Then GoTo Line7 'skipping items that are not used If Intersect(lrow.Range, tblRom.ListColumns("Bid Item").Range).Interior.Color = RGB(255, 117, 117) Then GoTo Line7 'skipping items that are rejected Line5A: If counter 1 Then GoTo Line8 PayItem = BidNum FNRSaveFile = FNRSavePath & "\" & PayItem & ".pdf" If (Dir(FNRSaveFile) "") Then Kill FNRSaveFile End If Call FileCopy(PDFTemplateFile, FNRSaveFile) 'Copy Template fdfName = PayItem & ".pdf" sFileHeader = "%FDF-1.2" & vbCrLf & _ "%âãÏÓ" & vbCrLf & _ "1 0 obj<</FDF<>>>" & vbCrLf & _ "endobj" & vbCrLf & _ "2 0 obj[" & vbCrLf sFileFooter = "]" & vbCrLf & _ "endobj" & vbCrLf & _ "trailer" & vbCrLf & _ "<>" & vbCrLf & _ "%%EO" sFileFields = "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf sFileFields = sFileFields & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf sFileFields = sFileFields & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf & _ "<>" & vbCrLf '"<>" & vbCrLf 'Static on Sheet sFileFields = Replace(sFileFields, "---Contract_No---", Contract_No) sFileFields = Replace(sFileFields, "---Project_Name---", Project_Name) sFileFields = Replace(sFileFields, "---Project_No---", Project_No) If Len(Acceptance) = 0 Then GoTo Line3 Else GoTo Line4 Line8: For i = 1 To 8 sFileFields = Replace(sFileFields, "---Item" & i & "---", "") sFileFields = Replace(sFileFields, "---Material" & i & "---", "") sFileFields = Replace(sFileFields, "---Product" & i & "---", "") sFileFields = Replace(sFileFields, "---Manufacturer" & i & "---", "") sFileFields = Replace(sFileFields, "---RAM" & i & "---", "") sFileFields = Replace(sFileFields, "---RamCode" & i & "---", "") 'sFileFields = Replace(sFileFields, "---Acceptance" & i & "---", "") Next i 'Save the item by the bid number sTmp = sFileHeader & sFileFields & sFileFooter sFileName = FNRSavePath & "\_" & PayItem & ".fdf" If (Dir(sFileName) "") Then Kill sFileName End If lngFileNum = FreeFile Open sFileName For Output As lngFileNum Print #lngFileNum, sTmp Close #lngFileNum DoEvents counter = 1 counter2 = 1 iFields = 1 pagecount = 0 GoTo line1 line2: If Len(BidNum) > 6 Then BidNum = Int(BidNum) sFileFields = Replace(sFileFields, "---Item" & iFields & "---", BidNum) sFileFields = Replace(sFileFields, "---Material" & iFields & "---", BidItem) sFileFields = Replace(sFileFields, "---Product" & iFi...

Expand

This file was truncated for preview. Please download to view the full file.