How to create multilevel drop-down list in word

edeszti · #1 06-08-2020, 01:24 AM

Hi,

I want to add multilevel (3-level) dependent drop-down lists to a word document which imports the data from excel cells.
I used the logic of this excel example:
VBA: Multilevel dependent drop-down in User Form - PK: An Excel Expert

There are three content controls in the word document: Category, Sub Category and Item. The content of the Sub Category drop-down list depends on the selected value of the Category drop-down list, and the content of the Item drop-down list depends on the selected value of the Sub Category drop-down list.
My problem is that the macro doesn't update the Sub Category and the Item drop-down lists. I use Document_ContentControlOnExit event.

I attach the .docm and the excel.
Code:

Code:

Private Sub Document_ContentControlOnExit(ByVal CCtrl As ContentControl, Cancel As Boolean)
Application.ScreenUpdating = False

Dim xlApp As New Excel.Application, xlWkBk As Excel.Workbook
Dim StrWkBkNm As String, StrWkShtNm As String, LRow As Long, i As Long

StrWkBkNm = "c:\.....\teszt_lista.xlsx"
StrWkShtNm = "Sheet1"
If Dir(StrWkBkNm) = "" Then
  MsgBox "Cannot find the designated workbook: " & StrWkBkNm, vbExclamation
  Exit Sub
End If
Dim cc1 As ContentControl, cc2 As ContentControl, cc3 As ContentControl

Set cc1 = ActiveDocument.SelectContentControlsByTitle("Category").Item(1)
Set cc2 = ActiveDocument.SelectContentControlsByTitle("SubCategory").Item(1)
Set cc3 = ActiveDocument.SelectContentControlsByTitle("Item").Item(1)

xlApp.Visible = False
Set xlWkBk = xlApp.Workbooks.Open(FileName:=StrWkBkNm, ReadOnly:=True, AddToMRU:=False)
LRow = xlWkBk.Worksheets(StrWkShtNm).Cells(.Rows.Count, 1).End(xlUp).Row

With CCtrl
    Select Case .Title
        Case "Category"
            cc2.DropdownListEntries.Clear
            For i = 2 To LRow
                If Trim(.Range("A" & i)) = "Sub Category" Then
                    If Trim(.Range("C" & i)) = .Range.Text Then
                        cc2.DropdownListEntries.Add Text:=Trim(.Range("B" & i))
                    End If
                End If
            Next
        Case "SubCategory"
            cc3.DropdownListEntries.Clear
            For i = 2 To LRow
                If Trim(.Range("A" & i)) = "Item" Then
                    If Trim(.Range("C" & i)) = .Range.Text Then
                        cc3.DropdownListEntries.Add Text:=Trim(.Range("B" & i))
                    End If
                End If
            Next
    End Select
End With
xlWkBk.Close False
xlApp.Quit
Application.ScreenUpdating = True
 End Sub

Thanks a lot in advance

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Convert multilevel bullet list to multilevel numbered list	scadaman29325	Word	2	03-27-2020 03:27 PM
Create Drop Down list to change cell color	bksmith	Excel	2	08-21-2017 02:37 AM
create a drop down list	jeffk	Excel	3	09-10-2015 07:38 AM
How to create a drop down list with sub categories	Gooford	Word	0	06-18-2014 03:46 AM
Create Drop Down List Box	hbradshaw	Word VBA	0	09-27-2010 06:24 AM