Dropdown list dependency and autofill

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

LustNik · #2 03-15-2022, 12:28 AM

Both of the last solutions worked! Fantastic, thanks alot for the help.

LustNik · #3 03-15-2022, 02:17 AM

For some reason this solution removes the dropdown options in the "risiko" cells upon closing and then opening the document. It seems to only be the case if nothing has been filled into the cell before exiting.

Preferably I would like to be able to take a copy of the document before filling anything into the table, so I can make multiple copies of that same doc.

Quote:

Originally Posted by macropod

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:
...
From then on, the only macro you need in the document is:

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