Add item to wdContentControlDropdownList

I had this question after viewing Word VBA How to programmatically set highlight color of dropdown content control?.

Hi,
I want to populate unique values from a excel column to a wdContentControlDropdownList and assign it to a bookmark defined in word. Can you help how to do it?

For the time being, I have tried hard coding the list entries but still no luck. below is the code.

Dim lobdd As ContentControl
Dim WRD As Object
Dim ws As Worksheet
Dim DOC As Object
Set ws = ThisWorkbook.Sheets("Sheet1")
lstrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
On Error Resume Next
    Set WRD = GetObject(, "Word.Application")
    If WRD Is Nothing Then Set WRD = New Word.Application
    Set DOC = WRD.Documents.Open ("path here" , ReadOnly:=False)
    WRD.Activate
Set lobdd = ActiveDocument.ContentControls.Add(wdContentControlDropdownList)
With WRD.ActiveDocument
str = ws.Range("B2").Value
.Bookmarks("Title").Range.Text = ws.Range("B2").Value
With lobdd
         .Title = "Cities"
         .SetPlaceholderText , , "[choose a City]"
        .LockContentControl = False
         .DropdownListEntries.Add Text:="Copenhagen", Value:="1"
         .DropdownListEntries.Add Text:="New York", Value:="2"
         .DropdownListEntries.Add Text:="London", Value:="3"
         .DropdownListEntries.Add Text:="Paris", Value:="4"
         End With
   Set lobdd = ActiveDocument.ContentControls.Add(wdContentControlDropdownList)
        With lobdd
         .Title = "Cities"
         .SetPlaceholderText , , "[choose a City]"
         .LockContentControl = False
         .DropdownListEntries.Add Text:="Copenhagen", Value:="1"
         .DropdownListEntries.Add Text:="New York", Value:="2"
         .DropdownListEntries.Add Text:="London", Value:="3"
         .DropdownListEntries.Add Text:="Paris", Value:="4"
         End With

Open in new window

above code is not working
Aparna KrishnanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
How is the code not working?

When I run this in a blank Word document it works without error and creates a dropdown list in the active document.
Sub DropDownTest()
Dim DOC As Document
Dim lobdd As ContentControl

    Set DOC = ActiveDocument
    
    Set lobdd = ActiveDocument.ContentControls.Add(wdContentControlDropdownList)
           
    With lobdd
         .Title = "Cities"
         .SetPlaceholderText , , "[choose a City]"
        .LockContentControl = False
         .DropdownListEntries.Add Text:="Copenhagen", Value:="1"
         .DropdownListEntries.Add Text:="New York", Value:="2"
         .DropdownListEntries.Add Text:="London", Value:="3"
         .DropdownListEntries.Add Text:="Paris", Value:="4"
    End With

End Sub

Open in new window

0
GrahamSkanRetiredCommented:
I have similar code to Norie's and it works for me as well.

I have put your own code into a snippet box for easier handling and viewing.

Remove the 'On Error Resume Nex't line so that you get better notification of any problem.
0
Aparna KrishnanAuthor Commented:
Hi,
Thank you for super fast response. I have the above in excel. From excel I am trying to create a content control drop down list in word at book marked location with hard coded data. but main intent to display unique values from column.  Do you see any error why the code would not work in excel?
0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Aparna KrishnanAuthor Commented:
Also when I tried the same after commenting 'On Error Resume Nex't line I am getting run time error 13.
0
Aparna KrishnanAuthor Commented:
on commenting On Error Resume Next, I am getting runtime error 429 activex component can't create object as it is failing in next line, Set WRD = GetObject(, "Word.Application") any suggestions?
0
NorieAnalyst Assistant Commented:
Have you set up a constant for the Word VBA constant wdContentControlDropdownList?
0
Aparna KrishnanAuthor Commented:
Hi,
I am novice with regard vba experience. below is the code. Are you referring to lobdd?

On Error Resume Next
    Set WRD = GetObject(, "Word.Application")
    If WRD Is Nothing Then Set WRD = New Word.Application
    Set DOC = WRD.Documents.Open("docx template here", ReadOnly:=False)
    WRD.Activate
   
    With WRD.ActiveDocument
        str = ws.Range("B2").Value
        .Bookmarks("Title").Range.Text = ws.Range("B2").Value
       
        Set lobrnge = ActiveDocument.Tables(1).Cell(2, 2).Range
        Set lobdd = ActiveDocument.ContentControls.Add(wdContentControlDropdownList, lobrnge)
        With lobdd
         .Title = "Cities"
         .SetPlaceholderText , , "[choose a City]"
         .LockContentControl = False
         .DropdownListEntries.Add Text:="Copenhagen", Value:="1"
         .DropdownListEntries.Add Text:="New York", Value:="2"
         .DropdownListEntries.Add Text:="London", Value:="3"
         .DropdownListEntries.Add Text:="Paris", Value:="4"
         End With
        .Bookmarks("LOB").Range.ContentControls.Add (lobdd)
        .Bookmarks("Primary_Func").Range.ContentControls.Add (wdContentControlDropdownList)
        .Bookmarks("Secondary_Func").Range.ContentControls.Add (wdContentControlDropdownList)
         .SaveAs ("path here" & str), _
         FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
        .Bookmarks("Title", "LOB", "Primary_Func", "Secondary_Func", "Primary_PoC", "Secondary_PoC", "Solution", "Benefits", "Benefit_Amount").Empty
        curr = ""
        lobdd.ClearAll
        lobdd.Delete
       
    End With
    Set WRD = Nothing
   
End Sub
0
GrahamSkanRetiredCommented:
Sorry. I didn't look too closely at the code. I just saw that you had suppressed errors for the whole routine. If Word is not already running you will get the error, but you need to restart error checking after creating the application.

   
 On Error Resume Next
    Set WRD = GetObject(, "Word.Application")
    If WRD Is Nothing Then Set WRD = New Word.Application
   On Error GoTo 0

    Set DOC = WRD.Documents.Open("docx template here", ReadOnly:=False)
 

Open in new window

0
Aparna KrishnanAuthor Commented:
Thank you. I am able to get drop down with title alone in word document. still not able to see the entries?
0
Aparna KrishnanAuthor Commented:
After including On Error GoTo 0 I am getting run time error 13. type mismatch in line .SetPlaceholderText , , "[choose a City]"
0
GrahamSkanRetiredCommented:
That's a mystery. The same code works on my system.

It shouldn't be necessary, but does it help to specify which library holds the ContentControl class details. You do this when the object is declared (Word in this case)

Dim lobdd As Word.ContentControl

Open in new window

0
Aparna KrishnanAuthor Commented:
I am getting run time error 4601 on reopening application again, it is run time error 13.
0
GrahamSkanRetiredCommented:
Your code indicates that you are using early binding. Do you have the correct Word Object library declared in Excel?  (Tools/References in the VBA IDE)
0
Aparna KrishnanAuthor Commented:
Kindly excuse my ignorance but
1) how do I find if it is early or late binding ( pretty new to working with excel vba)
2) What are the required correct Word Object library declared in Excel?  (Tools/References in the VBA IDE)
3) can you please help me with for loop to iterate till last row and display only unique values of column in wdContentControlDropdownList

Thank you..
0
GrahamSkanRetiredCommented:
To  use late binding, the library is not set in the Tools/Reference section. Objects not in a library are declared as type Object.

Dim lobdd As Object
Dim WRD As Object

Open in new window


If the library is set, then it is early binding and you can use the specific type in the declarations:
Dim obdd As Word.ContentControl
Dim WRD As Word.Application

Open in new window


Early binding is slightly faster at run time, but the real advantage comes when writing the code, because you will get context-sensitive pop-ups known as 'Intellisense'. The disadvantage might come when you distribute the application if there are differences between the library versions. For this reason most developers work in early binding and convert to late for distribution.

If you look in the Tools/References section in Excel, you will see that some libraries  are already ticked by the system, but Word isn't one of them. You need the Microsoft Word Object library.
0
Aparna KrishnanAuthor Commented:
Thank much for the detailed explanation along with code snippet. I have written below for loop to iterate excel column A to create drop down. This is not working at all. could you pls help me correct this?


For j = 2 To 5
           
           ActiveDocument.ContentControls(1).DropdownListEntries.Add Trim(.Range("A" & i))
        Next j
         
error message -
Run time error 451 - property let procedure not defined and property did not return an object
0
NorieAnalyst Assistant Commented:
Aparna

Can you post your full current code?
0
GrahamSkanRetiredCommented:
It sounds as it there is something wrong with the Word object library, rather than incorrect VBA code. If you are using  early binding, what version of the Microsoft Word object library have you ticked, and are there any others? Can you also list all the libraries that have been ticked in your Excel VBA References?
0
Aparna KrishnanAuthor Commented:
Microsoft word 16.0
Activex Data object library 6.1
Activex Data object Recordset 2.8
0
Aparna KrishnanAuthor Commented:
Private Sub CommandButton1_Click()
'declare objects
Dim WRD As Object
Dim ws As Worksheet
Dim DOC As Object

'Dim sfnCollection As New Collection
'Dim sfnCell As Range
'Dim sfnString As Variant

'initialize objects
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Dim lstrow As Integer
    lstrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
    Dim i As Integer
    For i = 2 To 3
    On Error Resume Next
    
    Set WRD = GetObject(, "Word.Application")

    If WRD Is Nothing Then Set WRD = New Word.Application
    
    Set DOC = WRD.Documents.Open <- template name here

    WRD.Activate
    'WRD.Visible = True

    Dim str, lob, pfunc, sfunc, curr, lstr As String
    Dim j, k, l As Integer
    
    Dim lobCollection As New Collection
    Dim lobCell As Range
    Dim lobString As Variant
 
    With DOC.ActiveDocument
        str = ws.Range("B" & i).Value
        .Bookmarks("Title").Range.Text = str
      
      ' DISPLAY LOB FROM EXCEL SHEET
        For Each lobCell In Range(Range("c2"), Range("c65536").End(xlUp))
            On Error Resume Next
            For Each lobString In Split(CStr(lobCell.Value), ",")
                lobCollection.Add Item:=lobString, Key:=lobString
            Next lobString
            On Error GoTo 0
        Next lobCell
         
        With DOC.ListBox1
           For Each lobString In lobCollection
                .AddItem lobString
           Next lobString
        End With
       
       lob = ws.Range("C" & i).Value
       With DOC.ListBox1
        For j = 1 To lobCollection.Count
             If lobCollection.Item(j) = lob Then
             .ListIndex = j - 1
             Exit For
             End If
           Next j
       End With
        
        With DOC.ListBox2
            Select Case lob
              Case "Payer"
                 .Clear
                 .AddItem "Rating and Underwriting"
                 .AddItem "Product Dev and Admin"
                 .AddItem "Marketing"
                 .AddItem "Sales"
                 .AddItem "Advertising and Promotions"
            End Select
          End With
        
        pfunc = ws.Range("E" & i).Value
        With DOC.ListBox2
        For k = 0 To DOC.ListBox2.ListCount - 1
             If DOC.ListBox2.List(k) = pfunc Then
                DOC.ListBox2.ListIndex = k
                Exit For
              End If
           Next k
       End With
          
        With DOC.ListBox3
           Select Case pfunc
              Case "Product Dev and Admin"
                    .AddItem "Actuarial"
                    .AddItem "Product Build Automation"
                    .AddItem "Data analytics And Reporting"
                    .AddItem "Test Automation"
                    .AddItem "Enhancements"
                    .AddItem "Conduct Research"
                    .AddItem "Build and Deploy Product"
                    .AddItem "Version Upgrade"
                Case "Marketing"
                    .AddItem "Campaign Management"
                    .AddItem "Strategy and Positioning"
                    .AddItem "Broker Management"
                    .AddItem "Content Management"
                    .AddItem "Segmentation and Targeting"
                    .AddItem "Sales portal"
            End Select
      End With
      sfunc = ws.Range("F" & i).Value
       With DOC.ListBox3
        For l = 0 To DOC.ListBox3.ListCount - 1
             If DOC.ListBox3.List(l) = sfunc Then
                DOC.ListBox3.ListIndex = l
                Exit For
              End If
           Next l
       End With
                 
        .Bookmarks("Primary_PoC").Range.Text = ws.Range("G" & i).Value
        .Bookmarks("Secondary_PoC").Range.Text = ws.Range("H" & i).Value
        .Bookmarks("Solution").Range.Text = ws.Range("I" & i).Value
        .Bookmarks("Benefits").Range.Text = ws.Range("J" & i).Value
        curr = FormatCurrency(ws.Range("K" & i).Value)
        .Bookmarks("Benefit_Amt").Range.Text = curr
        .SaveAs ("Doc name here" & str), _
         FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False
        '.Bookmarks("Benefit_Amt", "Benefits", "Primary_PoC", "Secondary_PoC", "Solution", "Title").Range.Text = ""
        curr = ""

    End With
    Set WRD = Nothing
    Next i
    
 End Sub

Open in new window

0
GrahamSkanRetiredCommented:
As far as I can tell, there are no other libraries earlier in the list that are likely to have a ContentControl class that might be picked up instead of the correct one. The conclusion that I come to is that the library itself has a problem, so I suggest that you do an Office repair.

I note that your code still doesn't have an 'On Error GoTo 0' line to reactivate the suppressed error checking. It needs to go around line 23.  Also, I have put the code into a snippet box. You can do that when composing a question or a comment by selecting it and clicking 'CODE' in the tool bar above the editor.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.