'Force the explicit declaration of variables
Option Explicit
'The following procedure will add a list of items from the specified
'range in a worksheet of an Excel workbook to the specified combobox
'in this document (the one running this code)
Sub AddItemsToContentControl()
'start a new instance of Excel
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
'xlApp.Visible = True
'open the specified workbook (change the path and filename accordingly)
Dim xlSourceWorkbook As Object
Set xlSourceWorkbook = xlApp.workbooks.Open( _
FileName:="c:\users\domenic\desktop\sample.xlsm", _
ReadOnly:=False)
'set the range containing the list of items
Dim xlSourceRange As Object
With xlSourceWorkbook.worksheets("Sheet1")
Set xlSourceRange = .Range("A2:A" & .Cells(.Rows.Count, "A").End(-4162).Row) '-4162 = xlUp
End With
'get the content control having the title "MyTitle" and tag "MyTag" (change accordingly)
Dim oContentControl As ContentControl
Dim itemsAdded As Boolean
Set oContentControl = GetContentControl("MyTitle", "MyTag")
If Not oContentControl Is Nothing Then
'add the entries from the range to the content control
AddDropdownListEntries oContentControl, xlSourceRange
itemsAdded = True
End If
'close the Excel workbook
xlSourceWorkbook.Close SaveChanges:=False
'quit the Excel application
xlApp.Quit
'display message to user of success or failure
If itemsAdded Then
MsgBox "Items added to ComboBox.", vbInformation
Else
MsgBox "Content control not found!", vbExclamation
End If
'clear the objects from memory
Set xlApp = Nothing
Set xlSourceWorkbook = Nothing
Set xlSourceRange = Nothing
Set oContentControl = Nothing
End Sub
'This function returns the content control having the title theTitle and the tag theTag
Public Function GetContentControl(ByVal theTitle As String, ByVal theTag As String) As ContentControl
Dim oContentControl As ContentControl
For Each oContentControl In ThisDocument.ContentControls
If oContentControl.Title = theTitle And oContentControl.Tag = theTag Then
Set GetContentControl = oContentControl
Exit Function
End If
Next oContentControl
Set GetContentControl = Nothing
End Function
'This procedure adds the items from the range xlSourceRange to theContentControl
Public Sub AddDropdownListEntries(ByVal theContentControl As ContentControl, ByVal xlSourceRange As Object)
theContentControl.DropdownListEntries.Clear
Dim xlCell As Object
For Each xlCell In xlSourceRange
theContentControl.DropdownListEntries.Add Text:=xlCell.Value
Next xlCell
End Sub
