Microsoft Office Forums - View Single Post - [Solved] Dropdown list dependency and autofill

macropod · 03-14-2022, 03:48 PM

Create one each of your Relevans & Risiko content controls, both with their relevant drop-down entries, then copy them to each of the other cells. Having done that, run the following macro:

Code:

Sub ConfigureRisiko()
Dim CCtrl As ContentControl
For Each CCtrl In ActiveDocument.ContentControls
  With CCtrl
    If .Title = "Risiko" Then
      .Type = wdContentControlRichText
      .Range.Text = " "
      .LockContents = True
    End If
  End With
Next
End Sub

From then on, the only macro you need in the document is:

Code:

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False
Dim r As Long, StrIn As String
With CCtrl
  r = .Range.Cells(1).RowIndex
  Select Case .Title
    Case "Relevans"
      StrIn = .Range.Text
      With .Range.Tables(1).Cell(r, 5).Range.ContentControls(1)
        If StrIn = "Ja" Then
          If .Type = wdContentControlRichText Then
            .LockContents = False
            .Range.Text = ""
            .Type = wdContentControlDropdownList
            .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
          End If
        ElseIf StrIn = "Nei" Then
          .LockContents = False
          .Type = wdContentControlRichText
          .Range.Text = "_"
          .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
          .LockContents = True
        Else
          .LockContents = False
          .Type = wdContentControlRichText
          .Range.Text = " "
          .Range.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
          .LockContents = True
        End If
      End With
    Case "Risiko"
      If .LockContents = False 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 Select
End With
Application.ScreenUpdating = True
End Sub