Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim StrPwd As String
StrPwd = "Password"
With ContentControl
  If Len(.Title) < 4 Then Exit Sub
  If Left(.Title, 4) = "SHR1" Then
    If ActiveDocument.ProtectionType <> wdNoProtection Then ActiveDocument.Unprotect Password:=StrPwd
    Select Case .Range.Text
      Case "Red": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
      Case "Yellow": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
      Case "Green": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
      Case Else: .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
    End Select
    ActiveDocument.Protect wdAllowOnlyFormFields, True, StrPwd
  End If
  If Left(.Title, 4) = "SHR2" Then
    If ActiveDocument.ProtectionType <> wdNoProtection Then ActiveDocument.Unprotect Password:=StrPwd
    Select Case .Range.Text
      Case "Red": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdRed
      Case "Yellow": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdYellow
      Case "Green": .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdBrightGreen
      Case Else: .Range.Cells(1).Shading.BackgroundPatternColorIndex = wdNoHighlight
    End Select
    ActiveDocument.Protect wdAllowOnlyFormFields, True, StrPwd
  End If
End With
End Sub