View Single Post
 
Old 03-24-2015, 07:44 PM
Guessed's Avatar
Guessed Guessed is offline Windows 7 32bit Office 2010 32bit
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 3,980
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

Try this version of the code and set every checkbox to run MakeCheckBoxesExclusive on Exit

Code:
Sub MakeCheckBoxesExclusive()
  Dim oFF As FormField, rng As Range
  
    Set rng = Selection.Rows(1).Range
  
  If Selection.FormFields(1).CheckBox.Value Then
    For Each oFF In rng.FormFields
      oFF.CheckBox.Value = False
    Next oFF
    Selection.FormFields(1).CheckBox.Value = True
  End If
  
  'Must unprotect to change cell shading
  ActiveDocument.Unprotect Password:=""
    If rng.FormFields(2).CheckBox.Value = True Then
      ShadeCells rng.Rows(1)
    Else
      ClearCells rng.Rows(1)
    End If
  ActiveDocument.Protect Type:=wdAllowOnlyFormFields, noReset:=True, Password:=""
End Sub

Function ShadeCells(oRow As Row)
  Dim lngIndex As Long
  For lngIndex = 4 To 7
    Select Case fcnCellText(oRow.Cells(lngIndex))
      Case "Y"
        oRow.Cells(lngIndex).Range.Shading.BackgroundPatternColor = wdColorRed
      Case "Y*"
        oRow.Cells(lngIndex).Range.Shading.BackgroundPatternColor = wdColorBrown
     End Select
  Next
lbl_Exit:
  Exit Function
End Function
Function ClearCells(oRow As Row)
  oRow.Range.Shading.BackgroundPatternColor = wdColorAutomatic
End Function
Function fcnCellText(oCell As Cell) As String
  Dim oRng As Word.Range
  Set oRng = oCell.Range
  oRng.End = oRng.End - 1
  fcnCellText = oRng.Text
lbl_Exit:
  Exit Function
End Function
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote