Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim orng As Range
    Select Case ContentControl.Range.Text
        Case "High"
            AutoTextToBM "bmRating", ActiveDocument.AttachedTemplate, "High"
        Case "Significant"
            AutoTextToBM "bmRating", ActiveDocument.AttachedTemplate, "Significant"
        Case "Low"
            AutoTextToBM "bmRating", ActiveDocument.AttachedTemplate, "Low"
        Case Else
            Set orng = ActiveDocument.Bookmarks("bmRating").Range
            orng.Text = ""
            ActiveDocument.Bookmarks.Add ("bmRating"), orng
    End Select
lbl_Exit:
    Set orng = Nothing
    Exit Sub
End Sub

Private Sub AutoTextToBM(strbmName As String, oTemplate As Template, strAutotext As String)
'strBMName is the name of the bookmark to fill
'oTemplate is the template with the autotext - probably ActiveDocument.AttachedTemplate
'strAutotext is the name of the autotext entry
Dim orng As Range
    On Error GoTo lbl_Exit
    With ActiveDocument
        Set orng = .Bookmarks(strbmName).Range
        Set orng = oTemplate.AutoTextEntries(strAutotext).Insert _
                   (Where:=orng, RichText:=True)
        .Bookmarks.Add Name:=strbmName, Range:=orng
    End With
lbl_Exit:
    Exit Sub
End Sub

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim strTxt As String, Rng As Range
With CCtrl
  If .Tag <> "Dropdown" Then Exit Sub
  If .ShowingPlaceholderText = True Then
    .Range.Font.StrikeThrough = False
    .Range.Font.Bold = False
    Exit Sub
  End If
  strTxt = .Range.Text
  If InStr(strTxt, "\") > 0 Then Exit Sub
  .Type = wdContentControlRichText
  .Range.Font.StrikeThrough = False
  .Range.Font.Bold = False
  With .Range
    .Text = "High\Significant\Low"
    .Font.StrikeThrough = True
    Set Rng = .Duplicate
    With Rng
      .End = .Start + InStr(.Text, "\")
      .Start = .End - 1
      .Font.StrikeThrough = False
    End With
    Set Rng = .Duplicate
    With Rng
      .End = .Start + InStrRev(.Text, "\")
      .Start = .End - 1
      .Font.StrikeThrough = False
    End With
    Set Rng = .Duplicate
    With Rng
      .Start = .Start + InStr(.Text, strTxt) - 1
      If InStr(.Text, "\") > 1 Then .End = .Start + InStr(.Text, "\") - 1
      .Font.StrikeThrough = False
      .Font.Bold = True
    End With
  End With
  .Type = wdContentControlDropdownList
End With
End Sub