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

shanshan89 · 08-11-2022, 11:53 PM

Quote:

Originally Posted by Guessed

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

Dear Guessed,

I just tried this and it works perfectly for me! Thank you very much!

Separately, do you have a solution to my earlier question on writing an excel VBA code to remove all blank cells and duplicates in all sheets of an excel workbook?

This was my earlier code as shared (see below) but this was to remove blank cells only. Now, I wanted to remove the duplicates as well.

Sub WorksheetLoop()

' Declare Current as a worksheet object variable.
Dim Current As Worksheet

' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets

' Insert your code here.
On Error Resume Next
Range("A2:A" & Current.UsedRange.Rows.Count).SpecialCells(xlCellT ypeBlanks).EntireRow.Delete

' This line displays the worksheet name in a message box.
MsgBox Current.Name

Next

End Sub