Private Sub Document_ContentControlOnExit(ByVal aCC As ContentControl, Cancel As Boolean)
  Dim StrPwd As String, iCol As Long
  StrPwd = "DocumentPassword"
  
  With aCC
    Select Case .Title
      Case "Lst1", "Lst2"
        'MsgBox .Range.Text
        Select Case .Range.Text
          Case "High"
            iCol = wdRed
          Case "Medium"
            iCol = wdYellow
          Case "Low"
            iCol = wdBrightGreen
          Case Else
            iCol = wdWhite
        End Select
        If ActiveDocument.ProtectionType <> wdNoProtection Then ActiveDocument.Unprotect Password:=StrPwd
        .Range.Cells(1).Shading.ForegroundPatternColorIndex = iCol
        ActiveDocument.Protect wdAllowOnlyFormFields, True, StrPwd
    End Select
  End With
End Sub