Private Sub Document_ContentControlOnExit(ByVal aCC As ContentControl, Cancel As Boolean)
  Dim dblColour As Double
  If aCC.Title = "Rating" Then
    Select Case aCC.Range.Text
      Case "Feasible"
        dblColour = wdColorGreen
      Case "Less Feasible"
        dblColour = wdColorYellow
      Case "Not Feasible"
        dblColour = wdColorRed
      Case Else
        dblColour = wdColorAutomatic
    End Select
    aCC.Range.Shading.BackgroundPatternColor = dblColour
  End If
End Sub