Checkbox Help - In Word - Anybody? SamT

[mhigh]

Hello everyone, im working on a word form that gets data from word and is automatically extracted to excel once it get in a specific folder. Most everything works fine, the only issue is that I have checkboxes on my forums and when they are clicked they print out either a 1 or 0.

Is there away that when a person checks a checkbox that data is placed under 1 column/header in excel with my other form data?

For example:
19509
If someone clicks on "No medical Treatment" it is placed in a cell under a column header called "Treatment" and if someone were to choose "First Aid" then that would show up.

Thanks!

[SamT]

Is there away that when a person checks a checkbox that data is placed under 1 column/header in excel with my other form data?Not without seeing the code that extracts the data to Excel.

Copy the Code in the VBA editor, then in our post editor, click the # icon, then press Ctrl+V

[mhigh]

Here is my code so far, ive tried a few random things for the checkboxes but they dont work so need some help in that department

Sub GetFormData() 'Note: this code requires a reference to the Word object model
Application.ScreenUpdating = False
Dim wdApp As New Word.Application
Dim wdDoc As Word.Document
' Dim CCtrl As Word.ContentControl
' Dim chckbox As Word.CheckBox ' TEST for ChcBOX
Dim FmFld As Word.FormField
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row

' strFile = Dir(strFolder & "\*.doc", vbNormal)
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
i = i + 1
Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
j = 0
' For Each CCtrl In .ContentControls
For Each FmFld In .FormFields
j = j + 1
' WkSht.Cells(i, j) = CCtrl.Range.Text
WkSht.Cells(i, j) = FmFld.Result
Next
End With

wdDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing: Set WkSht = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[SamT]

I don't do much Word coding, but something like this


For Each FmFld In .FormFields
If FrmFld.Type = wdFieldFormCheckBox Then
If FrmFld = 1 Then
j = j + 1
WkSht.Cells(i, j) = FmFld.Name
End If
Else
j = j + 1
' WkSht.Cells(i, j) = CCtrl.Range.Text
WkSht.Cells(i, j) = FmFld.Result
End If
Next

[mhigh]

It's done through excel to get the data, instead of it just printing out a 1 if its clicked i would love for it to print out what the checkbox is and put it under a single header if that makes any sense

[SamT]

Compare my code to yours in the for each loop

[mhigh]

It's not liking my 'Next' at the end

EDIT: fixed that issue above, now its saying object required when i run it

[mhigh]

monday bump

[snb]

Upload the wordfile.

[mhigh]

Hey I've gone a new route with content control instead of form controls now and its working pretty well, still the only thing i need is just to get the chckbox or radio buttons to give data to my excel sheet

19540


Sub getWordFormData()Dim wdApp As New Word.Application
Dim myDoc As Word.Document
Dim CCtl As Word.ContentControl
Dim myFolder As String, strFile As String
Dim myWkSht As Worksheet, i As Long, j As Long


myFolder = "C:\Users\mhigh\Documents\TestExcel"
Application.ScreenUpdating = False


If myFolder = "" Then Exit Sub
Set myWkSht = ActiveSheet
ActiveSheet.Cells.Clear
Range("A1") = "Job#"
Range("a1").Font.Bold = True
Range("B1") = "Job Name"
Range("B1").Font.Bold = True
Range("C1") = "Employee Name"
Range("C1").Font.Bold = True
Range("D1") = "Date of Report"
Range("D1").Font.Bold = True
Range("E1") = "Employee ID #"
Range("E1").Font.Bold = True
Range("F1") = "Date of Incident"
Range("F1").Font.Bold = True
Range("G1") = "Nature of Injury"
Range("G1").Font.Bold = True
Range("H1") = "Date Returned to Work"
Range("H1").Font.Bold = True
Range("I1") = "Any Work Restrictions"
Range("I1").Font.Bold = True
Range("J1") = "Work Restrictions"
Range("J1").Font.Bold = True
Range("K1") = "Employee Address"
Range("K1").Font.Bold = True
Range("L1") = "Incident Address"
Range("L1").Font.Bold = True
Range("M1") = "Employee's Occupation"
Range("M1").Font.Bold = True
Range("N1") = "Date of Birth"
Range("N1").Font.Bold = True
Range("O1") = "Gender"
Range("O1").Font.Bold = True
Range("P1") = "Affected Body Part"
Range("P1").Font.Bold = True
Range("Q1") = "Start Time of Injury"
Range("Q1").Font.Bold = True
Range("R1") = "Hours Worked Last 7 Days"
Range("R1").Font.Bold = True
Range("S1") = "Normal Shift"
Range("S1").Font.Bold = True
Range("T1") = "Foreman Present"
Range("T1").Font.Bold = True
Range("U1") = "How Long at Thompson"
Range("U1").Font.Bold = True




i = myWkSht.Cells(myWkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(myFolder & "\*.docx", vbNormal)

While strFile <> ""
i = i + 1

Set myDoc = wdApp.Documents.Open(Filename:=myFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)

With myDoc
j = 0
For Each CCtl In .ContentControls
j = j + 1
myWkSht.Cells(i, j) = CCtl.Range.Text
Next
myWkSht.Columns.AutoFit
End With
myDoc.Close SaveChanges:=False
strFile = Dir()
Wend
wdApp.Quit
Set myDoc = Nothing: Set wdApp = Nothing: Set myWkSht = Nothing
Application.ScreenUpdating = True

End Sub

[SamT]

Embold the entire Header row at once with
Range("A1:U1").Font.Bold = True

Suggestion:

With myDoc
j = 0
For Each CCtl In .ContentControls
j = j + 1
If j = 7 then
For each ctrl in this group get the ID of the checked one
Select Case ID
Case "?w?": myWkSht.Cells(i, "G") = "Blah Blah"
Case "?x?": myWkSht.Cells(i, "G") = "Bleh Bleh"
Case "?y?": myWkSht.Cells(i, "G") = "BloH Bloh"
Case "?z?": myWkSht.Cells(i, "G") = "Bluh bluh"
End Select
Next
Else
myWkSht.Cells(i, j) = CCtl.Range.Text
End If
Next