Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
  Application.ScreenUpdating = False
  Dim i As Long, StrOut() As String, rngRow As Range, ccRis As ContentControl
  With CCtrl
    If .Title = "Relevans" Then
      Set ccRis = .Range.Cells(1).Next.Range.ContentControls(1)
      Select Case .Range.Text
        Case "Ja"
          StrOut = Split("Uakseptabel,Middels,Akseptabel", ",")
          With ccRis
            .Type = wdContentControlText
            .Range.Text = ""
            .Type = wdContentControlDropdownList
            .DropdownListEntries.Clear
            For i = 0 To UBound(StrOut)
              .DropdownListEntries.Add StrOut(i)
            Next i
          End With
        Case "Nei"
          With ccRis
            .Type = wdContentControlText
            .Range.Text = "—"
          End With
        Case Else
          With ccRis
            .Type = wdContentControlText
            .Range.Text = ""
          End With
      End Select
    ElseIf .Title = "Risiko" Then
      Select Case .Range.Text
        Case "Uakseptabel": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
        Case "Akseptabel": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(0, 176, 80)
        Case "Middels": .Range.Cells(1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
        Case Else: .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
      End Select
    End If
  End With
End Sub