Hi All this code works wonderfully in filling out a VA 28-1905 form from a worksheet in excel. However the checkboxes don't remain checked. They are checked when the form initially saves, but when you open it again then the checkboxes aren't check. I don't know how to resolve this. Any help would be appreciated. I don't program all of the time so if you have improvement suggestions that would be awesome as well.
I tried objJSO.flattenpages but I get a NotAllowedError: Security settings prevent access to this property or method. If I stop the code before the save everything is filled out properly, but after save the checkboxes reset to 0.
This code has been adapted from Christos Samaras' code.
Sub PDF1905filler()
'--------------------------------------------------------------------------------------
'This macro uses the data in sheet Write in order to fill a sample PDF form named
'Test Form, which is located in the same folder with this workbook. The data from
'each row is used to create a new PDF file, which is saved in the Forms subfolder.
'The code uses late binding, so no reference to external library is required.
'However, the code works ONLY with Adobe Professional, so don't try to use it with
'Adobe Reader because you will get an "ActiveX component can't create object" error.
'Written by: Christos Samaras
'Date: 15/10/2013
'e-mail: xristos.samaras@gmail.com
'site: https://myengineeringworld.net/////
'--------------------------------------------------------------------------------------
'Declaring the necessary variables.
Dim strPDFPath As String
Dim strFieldNames As Variant
Dim i As Long
Dim j As Integer
Dim LastRow As Long
Dim objAcroApp As Object
Dim objAcroAVDoc As Object
Dim objAcroPDDoc As Object
Dim objJSO As Object
Dim strPDFOutPath As String
Dim refArtP1 As Integer
Dim refArtP2 As Integer
Dim refTtlCost As Integer
Dim refQty As Integer
Dim refDelDate As Integer
Dim refQty2 As Integer
Dim refItem As Integer
Dim refRow As Integer
Dim x
Dim refFile As String
x = 4
'Disable screen flickering.
' Application.ScreenUpdating = False ' Undo this line!
'Specify the path of the sample PDF form.
'Full path example:
strPDFPath = FormView.Range("E20").Value
' PDFTemplateFile = .Range("E20").Value 'Template File Name
' SavePDFFolder = .Range("E22").Value 'Save PDF Folder
'Using workbook path:
'strPDFPath = ThisWorkbook.Path & "" & "Test Form.pdf"
'Fill the field names array for the PDF form.
strFieldNames = frm1905()
With FormView
If .Range("E20").Value = Empty Or .Range("E22").Value = Empty Then
MsgBox "Both PDF Template and Saved PDF Locations are required for macro to run"
Exit Sub
End If
End With
Dim mysheet As FormView
Dim p, ws_num As Integer
Dim oSheet As String
Dim refSheet As String
Dim starting_WS As Worksheet
Dim r
Set starting_WS = StartingSheet
ws_num = ThisWorkbook.Worksheets.Count
r = 3
For p = 3 To ws_num
ThisWorkbook.Worksheets(p).Activate
'oSheet = Sheets(i).Name
With ThisWorkbook.Worksheets(p)
refSheet = ThisWorkbook.Worksheets(p).Name
Debug.Print refSheet
oSheet = ThisWorkbook.Worksheets(p).Cells(1, 2).Value & " " & .Cells(1, 4).Value
Debug.Print oSheet
LastRow = ThisWorkbook.Worksheets(p).Cells(Rows.Count, 2).End(xlUp).Row
For i = 4 To LastRow
' 'Find the last row of data in sheet(2).
' With Sheet2
' .Activate
' LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
' End With
'
' 'Loop through all rows of sheet (2) and use the data to fill the PDF form.
' For i = 4 To LastRow
'Set path for file
strPDFOutPath = FormView.Range("E22").Value
Debug.Print "Top For Loop" & vbCrLf & strPDFOutPath
On Error Resume Next
'Initialize Acrobat by creating the App object.
Set objAcroApp = CreateObject("AcroExch.App")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the App object!", vbCritical, "Object error"
'Release the object and exit.
Set objAcroApp = Nothing
Exit Sub
End If
'Create the AVDoc object.
Set objAcroAVDoc = CreateObject("AcroExch.AVDoc")
'Check if the object was created.
If Err.Number <> 0 Then
MsgBox "Could not create the AVDoc object!", vbCritical, "Object error"
'Release the objects and exit.
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If
On Error GoTo 0
'Open the PDF file.
If objAcroAVDoc.Open(strPDFPath, "") = True Then
'Set the PDDoc object.
Set objAcroPDDoc = objAcroAVDoc.GetPDDoc
'Set the JS Object - Java Script Object.
Set objJSO = objAcroPDDoc.GetJSObject
On Error Resume Next
On Error GoTo Gewixx
objAcroApp.Show
'Fill in the static fields
'Veterans Name
'x = strFieldNames(6)
objJSO.GetField(strFieldNames(6)).Value = CStr(FormView.Cells(5, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(6)).Value
objJSO.GetField(strFieldNames(13)).Value = CStr(FormView.Cells(5, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(13)).Value
objJSO.GetField(strFieldNames(64)).Value = CStr(FormView.Cells(5, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(64)).Value
'Rehabilitation Goal
objJSO.GetField(strFieldNames(9)).Value = CStr(FormView.Cells(8, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(9)).Value
'VA File Number
objJSO.GetField(strFieldNames(7)).Value = CStr(FormView.Cells(11, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(7)).Value
'Veteran's Address
objJSO.GetField(strFieldNames(8)).Value = CStr(FormView.Cells(14, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(8)).Value
'School's Address
objJSO.GetField(strFieldNames(12)).Value = CStr(FormView.Cells(17, "C").Value)
'Debug.Print objJSO.GetField(strFieldNames(12)).Value
'Date
objJSO.GetField(strFieldNames(3)).Value = CStr(FormView.Cells(2, "I").Value)
'Debug.Print objJSO.GetField(strFieldNames(3)).Value
objJSO.GetField(strFieldNames(63)).Value = CStr(FormView.Cells(2, "I").Value)
'Debug.Print objJSO.GetField(strFieldNames(63)).Value
'Item Recieved Yes
objJSO.GetField(strFieldNames(99)).Value = "Yes"
objJSO.GetField(strFieldNames(83)).Value = "Yes"
objJSO.GetField(strFieldNames(85)).Value = "Yes"
objJSO.GetField(strFieldNames(87)).Value = "Yes"
objJSO.GetField(strFieldNames(89)).Value = "Yes"
objJSO.GetField(strFieldNames(91)).Value = "Yes"
objJSO.GetField(strFieldNames(95)).Value = "Yes"
refRow = 4
'Fill the form fields.
For j = 1 To 7
If j = 1 And r = p Then
MkDir strPDFOutPath & "\" & oSheet
strPDFOutPath = strPDFOutPath & "\" & oSheet
r = r + 1
Else
If j = 1 Then
strPDFOutPath = strPDFOutPath & "\" & oSheet
End If
End If
Debug.Print "Inside For Loop" & vbCrLf & strPDFOutPath
refArtP1 = RefTable.Cells(refRow, "a").Value
refArtP2 = RefTable.Cells(refRow, "b").Value
refTtlCost = RefTable.Cells(refRow, "c").Value
refQty = RefTable.Cells(refRow, "d").Value
refDelDate = RefTable.Cells(refRow, "e").Value
refQty2 = RefTable.Cells(refRow, "f").Value
refItem = RefTable.Cells(refRow, "g").Value
'objJSO.GetField(strFieldNames(j)).Value = CStr(Sheet1.Cells(i, j + 1).Value)
objJSO.GetField(strFieldNames(refArtP1)).Value = CStr(Sheets(p).Cells(x, "b").Value)
objJSO.GetField(strFieldNames(refArtP2)).Value = CStr(Sheets(p).Cells(x, "b").Value)
objJSO.GetField(strFieldNames(refTtlCost)).Value = CStr(Sheets(p).Cells(x, "c").Value)
objJSO.GetField(strFieldNames(refQty)).Value = CStr(Sheets(p).Cells(x, "d").Value)
objJSO.GetField(strFieldNames(refDelDate)).Value = CStr(Sheets(p).Cells(x, "e").Value)
objJSO.GetField(strFieldNames(refQty2)).Value = CStr(Sheets(p).Cells(x, "d").Value)
objJSO.GetField(strFieldNames(refItem)).Value = CStr(x)
If Err.Number <> 0 Then
'Close the form without saving the changes.
objAcroAVDoc.Close True
'Close the Acrobat application.
objAcroApp.Exit
Gewixx:
'Inform the user about the error.
MsgBox "The field """ & strFieldNames(j) & """ could not be found!", vbCritical, "Field error"
'Release the objects and exit.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If
'Exit Loop on Last Row
If x = LastRow Then
x = 4
GoTo Continue
End If
'Iterate through RefTable rows to assign numbers.
refRow = refRow + 1
x = x + 1
Next j
'Pick up here to exit page.
Continue:
On Error GoTo 0
'Enable screen flickering.
Application.ScreenUpdating = True
' 'All checkboxes to checked
objAcroApp.Show
objJSO.GetField(strFieldNames(22)).Value = 1
objJSO.GetField(strFieldNames(23)).Value = 1
objJSO.GetField(strFieldNames(24)).Value = 1
objJSO.GetField(strFieldNames(25)).Value = 1
objJSO.GetField(strFieldNames(26)).Value = 1
objJSO.GetField(strFieldNames(27)).Value = 1
objJSO.GetField(strFieldNames(28)).Value = 1
objJSO.GetField(strFieldNames(52)).Value = 1
'Veteran's Vocation Choice set focus
objAcroApp.Show
objJSO.GetField(strFieldNames(5)).SetFocus
Application.Wait Now + 0.00001
'Application.SendKeys "{Tab}", True
Application.SendKeys "{right}", True
'Create the output path with the term and class .pdf
Dim w
If x = 4 Then
w = LastRow
Else
w = x - 1
End If
refFile = "\" & oSheet & "." & w & ".pdf"
strPDFOutPath = strPDFOutPath & refFile
'frm1905
'Debug.Print "Save Directory" & vbCrLf & strPDFOutPath
'objJSO.flattenpages
'Save the form as new PDF file.
objAcroPDDoc.Save 2, strPDFOutPath
' Debug.Print vbCrLf; "First Pass"
'
' frm1905Check (strPDFOutPath)
'
'Close the form without saving the changes.
objAcroAVDoc.Close True
'Close the Acrobat application.
objAcroApp.Exit
'Release the objects.
Set objJSO = Nothing
Set objAcroPDDoc = Nothing
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Else
MsgBox "Could not open the file!", vbCritical, "File error"
'Close the Acrobat application.
objAcroApp.Exit
'Release the objects and exit.
Set objAcroAVDoc = Nothing
Set objAcroApp = Nothing
Exit Sub
End If
i = w
Next i
End With
Next p
'Inform the user that forms were filled.
MsgBox "All forms were created successfully!", vbInformation, "Finished"
End Sub
Aucun commentaire:
Enregistrer un commentaire