Microsoft Office Forums - View Single Post - Word Template with a drop down list to populate other fields

gmaxey · 07-07-2017, 10:16 AM

You are going have to roll up your sleeves and write an awful lot of code or tie your content control dropdown list to a data base.

I really don't see how "Clients Name" is associated with a selected provider but if you have a Excel files "Providers.xlsx" in the same folder as your template then something like this:

Code:

Option Explicit
Dim arrData As Variant
Private Sub Document_ContentControlOnEnter(ByVal oCC As ContentControl)
Dim lngIndex As Long
Dim strSQL As String
  Select Case oCC.Title
    Case "Provider"
      oCC.DropdownListEntries.Clear
      strSQL = "SELECT * FROM [Sheet1$];"
      xlFillList arrData, ThisDocument.Path & "\Providers.xlsx", "True", strSQL
      For lngIndex = 0 To UBound(arrData, 2)
        oCC.DropdownListEntries.Add arrData(0, lngIndex), arrData(0, lngIndex)
      Next lngIndex
  End Select
End Sub
Private Sub Document_ContentControlOnExit(ByVal oCC As ContentControl, Cancel As Boolean)
Dim lngIndex As Long
  Select Case oCC.Title
    Case "Provider"
      If Not oCC.ShowingPlaceholderText Then
        ActiveDocument.SelectContentControlsByTitle("Provider Address").Item(1).Range.Text = arrData(1, fcnDropDownIndex(oCC))
        ActiveDocument.SelectContentControlsByTitle("Client Name").Item(1).Range.Text = arrData(2, fcnDropDownIndex(oCC))
      Else
        ActiveDocument.SelectContentControlsByTitle("Provider Address").Item(1).Range.Text = vbNullString
        ActiveDocument.SelectContentControlsByTitle("Client Name").Item(1).Range.Text = vbNullString
      End If
  End Select
End Sub
Function fcnDropDownIndex(CC As ContentControl) As Long
Dim lngIndex As Long
  For lngIndex = 1 To CC.DropdownListEntries.Count
    If CC.DropdownListEntries.Item(lngIndex).Text = CC.Range.Text Then
      fcnDropDownIndex = lngIndex - 1
      Exit For
    End If
  Next
lbl_Exit:
  Exit Function
End Function
Public Function xlFillList(arrPassed As Variant, strWorkbook As String, _
                           bSuppressHeader As Boolean, strSQL As String)
Dim oConn As Object
Dim oRS As Object
Dim lngNumRecs As Long
Dim strConnection As String
  'Create connection:
  Set oConn = CreateObject("ADODB.Connection")
  If bSuppressHeader Then
   strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & strWorkbook & ";" & _
                    "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
  Else
   strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & strWorkbook & ";" & _
                    "Extended Properties=""Excel 12.0 Xml;HDR=NO"";"
  End If
  oConn.Open ConnectionString:=strConnection
  Set oRS = CreateObject("ADODB.Recordset")
  'Read the data from the worksheet.
  oRS.Open strSQL, oConn, 3, 1 '3: adOpenStatic, 1: adLockReadOnly
  With oRS
    'Find the last record.
    .MoveLast
    'Get count.
    lngNumRecs = .RecordCount
    'Return to the start.
    .MoveFirst
  End With
  arrPassed = oRS.GetRows(lngNumRecs)
  'Cleanup
  If oRS.State = 1 Then oRS.Close
  Set oRS = Nothing
  If oConn.State = 1 Then oConn.Close
  Set oConn = Nothing
lbl_Exit:
  Exit Function
End Function