Turn a Yes or No response in excel into a ticked checkbox in word

Question

I am converting information entered into an excel sheet into a word document. I have a Yes/No choice section in excel and when I run the program, that result is sent to a location in word. I would like it change to a tickbox at this stage. My current code is:

Option Explicit

Sub ReplaceText()
    
    Dim wApp As Object, wDoc As Object, rngMap As Range, rw As Range, wsData As Worksheet
    Dim res As Boolean, token As String, txt
    
    Set wApp = CreateObject(Class:="Word.Application") 'using an open Word document for testing....
    
    wApp.Visible = True
    
    'Set wDoc = wApp.Documents(1)
    Set wDoc = wApp.Documents.Add(Template:="FILELOCATION", NewTemplate:=False, DocumentType:=0)

    Set wsData = ThisWorkbook.Worksheets("Form Entry")
    'reference mapping table
    Set rngMap = ThisWorkbook.Worksheets("Mapping").ListObjects(1).DataBodyRange
    
    For Each rw In rngMap.Rows
        token = rw.Cells(1).Value                   'placeholder to be replaced
        txt = wsData.Range(rw.Cells(2).Value).Value 'value to replace with
        res = ReplaceToken(wDoc, token, txt)
        rw.Interior.Color = IIf(res, vbGreen, vbRed) 'flag succeed/fail
    Next rw
    
End Sub

'In word document `doc`, replace `<token>` with `txt`
'Return true/false depending on whether a replacement was made
Function ReplaceToken(doc As Object, token As String, txt) As Boolean
    Const wdReplaceAll = 2 'define Word constant
    Dim rng As Object
    Set rng = doc.Content
    ReplaceToken = rng.Find.Execute(FindText:="<" & token & ">", _
                                    ReplaceWith:=txt, _
                                    Replace:=wdReplaceAll)
End Function

I think I know how to create checkboxes with VBA, but not sure how to make them convert from a cell AND transfer from excel to word.

Answer 1

• If it is just a sign, you can use ChrW to create the checked/unchecked symbol.

Function ReplaceToken(doc As Object, token As String, txt) As Boolean
    Const wdReplaceAll = 2 'define Word constant
    Dim rng As Object
    Set rng = doc.Content
    Select Case UCase(txt)
    Case "YES"
        txt = ChrW(9746)  ' ☒
    Case "NO"
        txt = ChrW(9744)  ' ☐
    End Select
    ReplaceToken = rng.Find.Execute(FindText:="<" & token & ">", _
                                    ReplaceWith:=txt, _
                                    Replace:=wdReplaceAll)
End Function

---

• Below code inserts a interactive CheckBox if needed

Selection.Range.ContentControls.Add (wdContentControlCheckBox)