Microsoft Office Forums - View Single Post - Import list from Excel into drop-down content control in word

Guessed · 08-11-2022, 10:32 PM

Rather than test to see if a Content Control exists, you can loop through a specific group of Content Controls. So if the member of the group doesn't exist then there is no error and no need to check if it exists.

I've set the Tag property on each of the CC to "Simple List" but left the Title Property untouched as a differentiator.

Code:

Sub Document_Open()
  'The script below is to populate the simple List
  Dim strWorkbook As String, lngIndex As Long, arrData As Variant
  Dim oCC As ContentControl, oFF As FormField, bReprotect As Boolean
  Application.ScreenUpdating = False
  
  'The Excel file defining the simple list.  Change to suit.
  strWorkbook = ThisDocument.Path & "\Excel Data Store.xlsx"
  If Dir(strWorkbook) = "" Then
    MsgBox "Cannot find the designated workbook: " & strWorkbook, vbExclamation
    Exit Sub
  End If
  
  'Clear simple lists
  For Each oCC In ActiveDocument.SelectContentControlsByTag("Simple List")
    If oCC.DropdownListEntries.Item(1).Value = vbNullString Then
      'Assumes the CC has a placeholder "Choose Item" entry with no defined value. _
      Preserve the placeholder entry.
      For lngIndex = oCC.DropdownListEntries.Count To 2 Step -1
        oCC.DropdownListEntries.Item(lngIndex).Delete
      Next lngIndex
    Else
      oCC.DropdownListEntries.Clear    'Assumes no placeholder entry.  Simple clear list.
    End If
    
    'chose the relevant array source
    If oCC.Title = "Dropdown List 1" Then
      arrData = fcnExcelDataToArray(strWorkbook, "Sheet 1")
    ElseIf oCC.Title = "Dropdown List 2" Then
      arrData = fcnExcelDataToArray(strWorkbook, "Sheet 1")
    Else
      arrData = fcnExcelDataToArray(strWorkbook, "Sheet 1")
    End If
    
    'Write array to list entries
    For lngIndex = 0 To UBound(arrData, 2)
      oCC.DropdownListEntries.Add arrData(0, lngIndex), arrData(0, lngIndex)
    Next
  Next oCC
  
lbl_Exit:
  Application.ScreenUpdating = True
  Exit Sub
End Sub