Checkbox to Input AutoText

Question

I want to auto change the heading of document to read "AT1" when check box CH1 is checked and for the heading to change to "AT2" and some text (actual 4 rows in a table) further down document (highlighted in the screen grab) to be hidden when check box CH2 is checked.  Only check box CB1 or check box CB2 can be checked but not both. 

I know this can be done using bookmarks and some VB coding but admittedly I am a novice when it comes to VB so am help would be greatly appreciated.

The document is laid out using a table (if that makes a difference).

Answer 1

There are a couple of ways of doing calculations in Word tables, but there's nothing built in to do conditional formatting the way Excel does.

For calculations, there are two non-VBA methods, each of which has its drawbacks.

• Put legacy text form fields in the "incoming data" cells such as a1 and b1 in your example. In their Properties dialogs, check both "Fill-in enabled" and "Calculate on exit". For your example, you could name the first field F and the second field S (in the Bookmark box). Then in cell c1, insert an ordinary formula field with the field code { = F * S }. Each time the cursor exits either of the form fields, the formula field will automatically update. The drawback of this is that the legacy fields require restricting editing to "Filling in fields", which isn't always compatible with content controls elsewhere in the form.
• Leave the data entry fields as ordinary table cells. Insert an ordinary formula field in the calculated cell, using the functions available in the Help topic "Use a formula in a Word or Outlook table". In this case, the field code could be either { = PRODUCT(a1,b1) } or { = PRODUCT(LEFT) }. [Note: the a1 and b1 would have to be replaced with the actual column letters and row number in the table, which are not a, b, and 1 in your example.] The drawback is that the calculation isn't automatic; you must manually update the formula field, either by selecting it and pressing F9 or by going to Print Preview and back.

Neither of these would do anything about coloring the cell backgrounds or changing the content of cell d1.

Since the results of our previous exploration involve a macro, it would probably be best to continue on that path. In that case, the necessary code can be added to the ContentControlOnExit macro you already have.

• Insert plain text content controls in all four cells (and in the corresponding cells of other rows). Give each control a unique Tag value that includes the row number. For the example, I would use tags like F1, S1, R1, and Risk1, and just change the number for each additional row. (These don't have to be the actual row numbers.)
• Replace the code in your previous post with this...

Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)

    Dim ccCH1 As ContentControl

    Dim ccCH2 As ContentControl

    Dim ccATnum As ContentControl

    Dim ccF As ContentControl

    Dim ccS As ContentControl

    Dim ccR As ContentControl

    Dim ccRisk As ContentControl

    Dim intRow As Integer

    Dim intVal As Integer

    Dim rg As Range

    Set ccCH1 = ActiveDocument.SelectContentControlsByTag("CH1")(1)

    Set ccCH2 = ActiveDocument.SelectContentControlsByTag("CH2")(1)

    Set ccATnum = ActiveDocument.SelectContentControlsByTag("TITLE")(1)

    Select Case True ' tag of control being exited

        Case CC.Tag = "CH1"

            If CC.Checked Then

                ccCH2.Checked = False

                ccATnum.Range.Text = "AT1"

                ActiveDocument.Bookmarks("HIDE").Range.Font.Hidden = False

            Else

                ccCH2.Checked = True

                ccATnum.Range.Text = "AT2"

                ActiveDocument.Bookmarks("HIDE").Range.Font.Hidden = True

            End If

        Case CC.Tag = "CH2"

            If CC.Checked Then

                ccCH1.Checked = False

                ccATnum.Range.Text = "AT2"

                ActiveDocument.Bookmarks("HIDE").Range.Font.Hidden = True

            Else

                ccCH1.Checked = True

                ccATnum.Range.Text = "AT1"

                ActiveDocument.Bookmarks("HIDE").Range.Font.Hidden = False

            End If

        Case (CC.Tag Like "F*") Or (CC.Tag Like "S*")

            intRow = Right(CC.Tag, Len(CC.Tag) - 1)

            ' get the "R" control in the same row

            Set ccF = ActiveDocument.SelectContentControlsByTag("F" & intRow)(1)

            Set ccS = ActiveDocument.SelectContentControlsByTag("S" & intRow)(1)

            Set ccR = ActiveDocument.SelectContentControlsByTag("R" & intRow)(1)

            Set ccRisk = ActiveDocument.SelectContentControlsByTag("Risk" & intRow)(1)

            intVal = Val(ccF.Range.Text) * Val(ccS.Range.Text)

            ccR.Range.Text = intVal

            Set rg = ccR.Range.Duplicate

            'include cell marker, thus whole cell

            rg.MoveEnd wdCharacter, 2

            If intVal < 5 Then

                rg.Shading.BackgroundPatternColorIndex = wdBrightGreen

                ccRisk.Range.Text = "Low"

            ElseIf intVal <= 9 Then

                rg.Shading.BackgroundPatternColorIndex = wdYellow

                ccRisk.Range.Text = "Medium, Tolerable"

            Else

                rg.Shading.BackgroundPatternColorIndex = wdRed

                ccRisk.Range.Text = "High, Danger"

            End If

        Case Else

            Exit Sub

    End Select

End Sub

Answer 2

Thanks Jay

I'll review your above response later as I forgot to ask in my last post (and I figured we are on different time zones - I'm in England) would the above formula and conditional formatting (specific to a new row) apply to new rows in the table following + icon on the table?

The reason for this is the number of rows required for each use of the table varies.  I thought of just repeating the code for a single row say, 20 times (20 rows being more than the maximum number of rows ever required) and then deleting the unused rows in the table in Word but I suspect the VB code will error as references in the VB code will no longer exist in the Word table and I don't want the end user having to edit the VB code. 

Answer 3

If you're using the revised ContentcontrolOnExit procedure, it will work as long as you add the corresponding content controls with the correct tag values to the new row. The macro extracts the row number from the tag of the control that's currently being exited, and uses that to address all the other controls in the same row.

As I mentioned before, the "row numbers" in the control tags don't have to be the same as the actual row numbers of the table. For example, if the table has two heading rows, but the first row of content controls uses tag values with the number 1, then the actual row number of that row is 3. None of that matters to the code.

The only scheme I mentioned that depends on using the actual row numbers is the formula field with code like { = PRODUCT(a1,b1) }.

Answer 4

Hi Jay

This is a separate document than the one discussed earlier in this post but I think VB is the way to go.  I have tried to incorporate your code but struggled and only achieved a bit of success.

I have inserted plain text content controls in all four cells on the left and four  cells on the right and given each control a unique Tag value that includes the row number e.g. first row is F1, S1, R1, L1, FF1, SS1, RR1, LL1.  I thought it easier to double the letters to maintain unique Tags so the number could remain the same of all 8 cells for that row.

Note SS1 is all ways the same as S1 and it would be good to include this is the code rather than rely on the end user.  All cells left blank are manually entered by the end user.  It would be good to auto add the correct ID row 1 at the start.  Is this possible?

As you can see I had some success in that R1 shaded background and L1 content is from the VB code not manually inputted, but I cant seem to get the code to work again? 

The right hand side cells aren't functioning. I have treated the RHS cells as Case 2, is this correct? 

I am correct in once I have row 1 fully working I just need to add row 2, 3...nth for Dim and Set at the top of the code and insert plain text content controls in all eight cells changing the 1 to 2, 3...nth.  Is this correct?  If so my thoughts where to repeat for say 15 rows and the end user would just delete unused rows in the table not needing to edit the VB code.  Would this work without error?

Please can you explain what ' intRow = Right(CC.Tag, Len(CC.Tag) - 1) ' is doing?

See the code as it currently is below:-

Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)

    Dim ccF1 As ContentControl

    Dim ccS1 As ContentControl

    Dim ccR1 As ContentControl

    Dim ccL1 As ContentControl

    Dim ccFF1 As ContentControl

    Dim ccSS1 As ContentControl

    Dim ccRR1 As ContentControl

    Dim ccLL1 As ContentControl

    Dim intRow As Integer

    Dim intVal_1 As Integer

    Dim rg_1 As Range

    Dim intVal_2 As Integer

    Dim rg_2 As Range

    Set ccF1 = ActiveDocument.SelectContentControlsByTag("F1")(1)

    Set ccS1 = ActiveDocument.SelectContentControlsByTag("S1")(1)

    Set ccR1 = ActiveDocument.SelectContentControlsByTag("R1")(1)

    Set ccL1 = ActiveDocument.SelectContentControlsByTag("L1")(1)

    Set ccFF1 = ActiveDocument.SelectContentControlsByTag("FF1")(1)

    Set ccSS1 = ActiveDocument.SelectContentControlsByTag("SS1")(1)

    Set ccRR1 = ActiveDocument.SelectContentControlsByTag("RR1")(1)

    Set ccLL1 = ActiveDocument.SelectContentControlsByTag("LL1")(1)

Select Case True ' tag of control being exited

        Case CC.Tag = "F*"

            intRow = Right(CC.Tag, Len(CC.Tag) - 1)

            ' get the "R" control in the same row

            Set ccF = ActiveDocument.SelectContentControlsByTag("F" & intRow)(1)

            Set ccS = ActiveDocument.SelectContentControlsByTag("S" & intRow)(1)

            Set ccR = ActiveDocument.SelectContentControlsByTag("R" & intRow)(1)

            Set ccL = ActiveDocument.SelectContentControlsByTag("L" & intRow)(1)

            intVal_1 = Val(ccF.Range.Text) * Val(ccS.Range.Text)

            ccR.Range.Text = intVal_1

            Set rg_1 = ccR.Range.Duplicate

            'include cell marker, thus whole cell

            rg_1.MoveEnd wdCharacter, 2

            If intVal_1 < 5 Then

                rg_1.Shading.BackgroundPatternColorIndex = wdOliveGreen

                ccL.Range.Text = "Low, Broadly Acceptable"

            ElseIf intVal_1 <= 9 Then

                rg_1.Shading.BackgroundPatternColorIndex = wdLightOrange

                ccL.Range.Text = "Medium, Tolerable"

            Else

                rg_1.Shading.BackgroundPatternColorIndex = wdRed

                ccL.Range.Text = "High, Unacceptable"

            End If

        Case CC.Tag = "FF*"

            intRow = Right(CC.Tag, Len(CC.Tag) - 1)

            ' get the "R" control in the same row

            Set ccFF = ActiveDocument.SelectContentControlsByTag("FF" & intRow)(1)

            Set ccSS = ActiveDocument.SelectContentControlsByTag("SS" & intRow)(1)

            Set ccRR = ActiveDocument.SelectContentControlsByTag("RR" & intRow)(1)

            Set ccLL = ActiveDocument.SelectContentControlsByTag("LL" & intRow)(1)

            intVal_2 = Val(ccFF.Range.Text) * Val(ccSS.Range.Text)

            ccRR.Range.Text = intVal_2

            Set rg_2 = ccRR.Range.Duplicate

            'include cell marker, thus whole cell

            rg_2.MoveEnd wdCharacter, 2

            If intVal_2 < 5 Then

                rg_2.Shading.BackgroundPatternColorIndex = wdOliveGreen

                ccL.Range.Text = "Low, Broadly Acceptable"

            ElseIf intVal_2 <= 9 Then

                rg_2.Shading.BackgroundPatternColorIndex = wdLightOrange

                ccL.Range.Text = "Medium, Tolerable"

            Else

                rg_2.Shading.BackgroundPatternColorIndex = wdRed

                ccL.Range.Text = "High, Unacceptable"

            End If

        Case Else

            Exit Sub

    End Select

End Sub

Answer 5

Well, it has some problems, but they're fixable.

First, to answer your question about the line

intRow = Right(CC.Tag, Len(CC.Tag) - 1)

In the case of a function nested inside the argument of another function, always work from the inside outward. The Right function looks at a string variable (the first argument, before the comma) and extracts a substring of a specified length (the second argument) from the right end of the string. The 'inside' in this case is the function Len(CC.Tag), which returns the length of the tag string. For example, if the tag is F2, then the length is 2 characters; if the tag is F13, the length is 3 characters. Then subtract 1 from the length to get the size of the substring. If the CC.Tag string is F2, get one character from the right, which is 2; if the string is F13, get two characters from the right, or 13. In either case, the substring is the row number, and that's assigned as the value of the variable intRow.

The trouble with the tagging you set up has to do with the way the macro decides whether it's working on the left side of the table or the right side. First, you can't use the equal sign in a statement like

Case CC.Tag = "F*"

because VBA will then look for the literal string F* instead of F followed by other characters. That won't recognize any of the tags. Looking at the code I posted earlier, you'll see the statement

Case (CC.Tag Like "F*") Or (CC.Tag Like "S*")

The Like operator looks for patterns, and here the * means "any sequence of characters". If CC.Tag is F2 or F13 etc., then CC.Tag Like "F*" is true. Unfortunately, if CC.Tag is FF13, that also returns true. That doesn't let the macro treat the two sides of the table separately.

The solution I'll propose is to put an L at the beginning of the tag for controls on the left side, and an R at the beginning of the tag for controls on the right side. So LF1, LS1, LR1, LL1 and RF1, RS1, RR1, RL1. The code, which I've tested here, is below.

I've included a statement in each section of the code to make the LF and RF controls have the same value, as you mentioned. Also, note that the colors you picked, olive green and light orange, aren't available as values for BackgroundPatternColorIndex, but are values for BackgroundPatternColor. (You may want to pick a different one than wdColorOliveGreen, which is very dark and rather ugly.)

You don't have to add anything to this code to accommodate more rows in the table. Just make sure the tag values are correct in the added content controls.

Private Sub Document_ContentControlOnExit(ByVal CC As ContentControl, Cancel As Boolean)

    Dim ccCH1 As ContentControl

    Dim ccCH2 As ContentControl

    Dim ccATnum As ContentControl

    Dim ccF As ContentControl

    Dim ccS As ContentControl

    Dim ccR As ContentControl

    Dim ccL As ContentControl

    Dim intRow As Integer

    Dim intVal As Integer

    Dim rg As Range

    Select Case True

        Case (CC.Tag Like "LF*") Or (CC.Tag Like "LS*") ' exiting control in left side of table

            ' get the row number from the tag

            intRow = Right(CC.Tag, Len(CC.Tag) - 2)

            Set ccF = ActiveDocument.SelectContentControlsByTag("LF" & intRow)(1)

            Set ccS = ActiveDocument.SelectContentControlsByTag("LS" & intRow)(1)

            Set ccR = ActiveDocument.SelectContentControlsByTag("LR" & intRow)(1)

            Set ccL = ActiveDocument.SelectContentControlsByTag("LL" & intRow)(1)

            ' calculate value for LR control

            intVal = Val(ccF.Range.Text) * Val(ccS.Range.Text)

            ccR.Range.Text = intVal

            Set rg = ccR.Range.Duplicate

            'include cell marker, thus whole cell

            rg.MoveEnd wdCharacter, 2

            If intVal < 5 Then

                rg.Shading.BackgroundPatternColor = wdColorOliveGreen

                ccL.Range.Text = "Low, Broadly Acceptable"

            ElseIf intVal <= 9 Then

                rg.Shading.BackgroundPatternColor = wdColorLightOrange

                ccL.Range.Text = "Medium, Tolerable"

            Else

                rg.Shading.BackgroundPatternColor = wdColorRed

                ccL.Range.Text = "High, Unacceptable"

            End If

            ' make RF control's value same as LF control

            ActiveDocument.SelectContentControlsByTag("RF" & intRow)(1).Range.Text = _

                ccF.Range.Text

        Case (CC.Tag Like "RF*") Or (CC.Tag Like "RS*") ' exiting control in right side of table

            ' get the row number from the tag

            intRow = Right(CC.Tag, Len(CC.Tag) - 2)

            Set ccF = ActiveDocument.SelectContentControlsByTag("RF" & intRow)(1)

            Set ccS = ActiveDocument.SelectContentControlsByTag("RS" & intRow)(1)

            Set ccR = ActiveDocument.SelectContentControlsByTag("RR" & intRow)(1)

            Set ccL = ActiveDocument.SelectContentControlsByTag("RL" & intRow)(1)

            ' calculate value for RR control

            intVal = Val(ccF.Range.Text) * Val(ccS.Range.Text)

            ccR.Range.Text = intVal

            Set rg = ccR.Range.Duplicate

            'include cell marker, thus whole cell

            rg.MoveEnd wdCharacter, 2

            If intVal < 5 Then

                rg.Shading.BackgroundPatternColor = wdColorOliveGreen

                ccL.Range.Text = "Low, Broadly Acceptable"

            ElseIf intVal <= 9 Then

                rg.Shading.BackgroundPatternColor = wdColorLightOrange

                ccL.Range.Text = "Medium, Tolerable"

            Else

                rg.Shading.BackgroundPatternColor = wdColorRed

                ccL.Range.Text = "High, Unacceptable"

            End If

            ' make LF control's value same as RF control

            ActiveDocument.SelectContentControlsByTag("LF" & intRow)(1).Range.Text = ccF.Range.Text

        Case Else

            Exit Sub

    End Select

End Sub