使用VBA檢查adobe中的標記字段PRO

Question

我有讀取3個記錄集並將信息插入adobe PDF文件文本框的代碼。但現在我想開始檢查表單上的Adobe複選框。我在盒子上有十字架的樣式，並且簡單地檢查它。

這是我的代碼。它在底部。我正在嘗試添加它。

Private Sub Command46_Click() 

Dim StrSQl As String 
Dim Acrobat As AcroApp 
Dim AcrobatDocument As AcroAVDoc 

Dim fcount As Long 
Dim AFieldName As String 
Dim rsTable As DAO.Recordset 
Dim Rs As DAO.Recordset 
Dim rs1 As DAO.Recordset 
Dim rs2 As DAO.Recordset 

Set dbs = CurrentDb 
SP = "SP" 
y = "Y" 

EDIPI = Forms![COLA Form]![EDIPI INPUT].Value 

'Query data for MARINES INFO 
StrSQl = "" 

'Query For depn information other that SP 
strSQLDEPN = "" 

'Query for spouse information 
strSQLSP = " 





'Open a dynaset-type Recordset using a SQL 
Set Rs = dbs.OpenRecordset(StrSQl, dbOpenDynaset) 
Set rs1 = dbs.OpenRecordset(strSQLDEPN, dbOpenDynaset) 
Set rs2 = dbs.OpenRecordset(strSQLSP, dbOpenDynaset) 

'On Error Resume Next 

    depn2a = rs1.Fields("Depn Info First Name").Value + " " + rs1.Fields("Depn Info Mid Initial Id").Value + " " + rs1.Fields("Depn Info Last Name").Value 
    reldepn2a = rs1.Fields("Depn Info Relationship Code").Value 
    GAINDTD2a = rs1.Fields("Depn Info Birth Date").Value 
    rs1.MoveNext 

    depn3a = rs1.Fields("Depn Info First Name").Value + " " + rs1.Fields("Depn Info Mid Initial Id").Value + " " + rs1.Fields("Depn Info Last Name").Value 
    reldepn3a = rs1.Fields("Depn Info Relationship Code").Value 
    GAINDTD3a = rs1.Fields("Depn Info Birth Date").Value 
    rs1.MoveNext 

    depn4a = rs1.Fields("Depn Info First Name").Value + " " + rs1.Fields("Depn Info Mid Initial Id").Value + " " + rs1.Fields("Depn Info Last Name").Value 
    reldepn4a = rs1.Fields("Depn Info Relationship Code").Value 
    GAINDTD4a = rs1.Fields("Depn Info Birth Date").Value 
    rs1.MoveNext 

    depn5a = rs1.Fields("Depn Info First Name").Value + " " + rs1.Fields("Depn Info Mid Initial Id").Value + " " + rs1.Fields("Depn Info Last Name").Value 
    reldepn5a = rs1.Fields("Depn Info Relationship Code").Value 
    GAINDTD5a = rs1.Fields("Depn Info Birth Date").Value 
    rs1.MoveNext 

    depn5a = rs1.Fields("Depn Info First Name").Value + " " + rs1.Fields("Depn Info Mid Initial Id").Value + " " + rs1.Fields("Depn Info Last Name").Value 
    reldepn5a = rs1.Fields("Depn Info Relationship Code").Value 
    GAINDTD5a = rs1.Fields("Depn Info Birth Date").Value 
    rs1.MoveNext 

    depn6a = rs1.Fields("Depn Info First Name").Value + " " + rs1.Fields("Depn Info Mid Initial Id").Value + " " + rs1.Fields("Depn Info Last Name").Value 
    reldepn6a = rs1.Fields("Depn Info Relationship Code").Value 
    GAINDTD6a = rs1.Fields("Depn Info Birth Date").Value 
    rs1.MoveNext 


If Len(depn2a) = 0 Then 
depn2a = "AND NO OTHERS" 
ElseIf Len(depn3a) = 0 Then 
depn3a = "AND NO OTHERS" 
ElseIf Len(depn4a) = 0 Then 
depn4a = "AND NO OTHERS" 
ElseIf Len(depn5a) = 0 Then 
depn5a = "AND NO OTHERS" 
ElseIf Len(depn6a) = 0 Then 
depn6a = "AND NO OTHERS" 

End If 


'WRITING TO A ADOBE PRO FILE. 
'On Error GoTo ProcError 
Set Acrobat = CreateObject("AcroExch.App") 
Set AcrobatDocument = CreateObject("AcroExch.AVDoc") 

If AcrobatDocument.Open("C:\Users\jeffrey.spangler\Desktop\4 FORMS.PDF", "") Then 

Acrobat.Show 

Set AcroForm = CreateObject("AFormAut.App") 
Set Fields = AcroForm.Fields 'NUMBER OF FIELDS 

    'varibles from form 

    'varibles from recordsets 

    First = Rs.Fields("First Name").Value 
    Last = Rs.Fields("Last Name").Value 

    If Not (Rs.Fields("Middle Initial") = Null) Then 
    MI = " " 
    ElseIf Len(Rs.Fields("Middle Initial")) = 1 Then 
    MI = Rs.Fields("Middle Initial") 
    End If 

    Grade = Rs.Fields("Rank Id").Value 
    DOR = Rs.Fields("Permanent Rank Date").Value 
    SSN = Rs.Fields("SSN").Value 
    DCTB = Rs.Fields("Current Tour Begin Date").Value 

    If rs2.RecordCount = 1 Then 
    SPOUSENAME = rs2.Fields("Depn Info First Name").Value + " " + Rs.Fields("Depn Info Mid Initial Id").Value + " " + Rs.Fields("Depn Info Last Name").Value 
    SpRel = "SPOUSE" 
    DOM = rs2.Fields("Depn Info Gain Date").Value 
    Else: SPOUSENAME = "N/A" 
    End If 

    ' Loacting Blanket letters 

    'IF than statement to get history statements for commrats approval 
    Fields("LNAME").Value = Last 
    Fields("FNAME").Value = First 
    Fields("MI").Value = MI 
    Fields("RANK").Value = Grade 
    Fields("DOR").Value = DOR 
    Fields("SSN").Value = SSN 
    Fields("STATION").Value = "MCB Kaneohe Bay, HI" 
    Fields("DATE OF ORDERS").Value = DCTB 
    Fields("ARRIVAL").Value = DCTB 

    Fields("spouse").Value = SPOUSENAME 
    Fields("relationship").Value = SpRel 
    Fields("DOM").Value = DOM 

    Fields("depn 1").Value = depn2a 
    Fields("relation 2").Value = reldepn2a 
    Fields("dob1").Value = GAINDTD2a 

    Fields("depn 2").Value = depn3a 
    Fields("relation 3").Value = reldepn3a 
    Fields("dob2").Value = GAINDTD3a 

    Fields("depn 3").Value = depn4a 
    Fields("relation4").Value = reldepn4a 
    Fields("dob3").Value = GAINDTD4a 

    Fields("depn4").Value = depn5a 
    Fields("relation5").Value = reldepn5a 
    Fields("dob4").Value = GAINDTD5a 

    Fields("depn5").Value = depn6a 
    Fields("relation6").Value = reldepn6a 
    Fields("dob5").Value = GAINDTD6a 


    Fields("sponsorship").Value = "N/A" 
    Fields("Check Box1").Value = "x" ' 

這是我最後一次失敗的嘗試。這裏是需要幫助的地方

Else 

MsgBox ("failure to locate form") 
End If 
Acrobat.Exit 

Set Acrobat = Nothing 
Set AcrobatDocument = Nothing 
Set Field = Nothing 
Set Fields = Nothing 
Rs.Close 
Set Rs = Nothing 
Set rs1 = Nothing 

ProcExit: 
    Exit Sub 

ProcError: 
If Err.Number = 3021 Then 
MsgBox Err.Description 
End If 

Resume ProcExit 



    End Sub 

代碼運行就像一個冠軍，其他明顯的突破。

Answer 1

您必須更改屬性設置選項將yes更改爲-1才能設置輸入。輸入是Fields（「Check Box1」）。Value = -1