Dropdown list dependency and autofill

macropod · #6 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Autofill Dropdown	Syed Rashid	Word	1	06-22-2021 10:59 AM
Compose Email - Autofill List Style Change	RoscoW88	Outlook	2	05-24-2021 06:44 PM
Autofill a field based on drop down list selection	lascough20	Word	2	09-21-2018 02:24 AM
Selection of a dropdown creates another dropdown wih the list	krishnamurthy.ka2810	Word VBA	1	04-26-2018 11:44 PM
Autofill a form which is contingent on a dropdown selection.	biffle0764	Word	2	05-09-2012 12:54 PM