Populating Content Controls in Word document from Excel workbook (same names)

Hi,
I would like to populate Content Controls in embeded Word document with data from Excel named ranges. Content control fields have same names (Title) as named ranges in Excel.

So far I managed with my code to populate only one specified Content Control field from Excel named range (see below) - otherwise code works fine.
Obviously I have many more Content Control´s fields in document and I would like code to go through ALL Content control fields, so that I dont have to do it manualy, one by one.

Thanks in advance for any sugestions.:yes

Code:

---

Sub Populate_ContentControls_in_embeded_document()

Dim WordApp As Object
Dim WordDoc As Object
Dim CC As ContentControl

Set WordApp = GetObject(, "Word.Application")
   
With WordApp
Set WordDoc = .Documents("Dokument v " & ActiveWorkbook.Name) 'example of embeded document name: "Dokument v AAA_ZAKÁZKA.xlsm"
End With


'Go through all CC in embeded Word document and if there is some with title that is the same as excel named range - then populate CC with text from excel named range

For Each CC In WordDoc.ContentControls

    If CC.Title = ActiveWorkbook.Names("hello").Name Then
    CC.Range.Text = Range("hello").Text
    End If

Next


End Sub

---

Try swapping the below:

Code:

---

For Each CC In WordDoc.ContentControls   
    If CC.Title = ActiveWorkbook.Names("hello").Name Then
        CC.Range.Text = Range("hello").Text
    End If
Next

---

For

Code:

---

On Error Resume Next
 For Each CC In WordDoc.ContentControls
    If CC.Title = ActiveWorkbook.Names(CC.Title).Name Then
        CC.Range.Text = Range(CC.Title).Text
    End If
Next
On Error GoTo 0

---

Or you could use a UDF to check if the range exists on the active sheet:

Code:

---

Function RangeExists(R As String) As Boolean   
    Dim Test As Range
    On Error Resume Next
    Set Test = ActiveSheet.Range(R)
    RangeExists = Err.Number = 0
End Function

---

And use it like:

Code:

---

Sub Populate_ContentControls_in_embeded_document()   
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim CC As ContentControl


    Set WordApp = GetObject(, "Word.Application")
    Set WordDoc = WordApp.Documents("Dokument v " & ActiveWorkbook.Name) 'example of embeded document name: "Dokument v AAA_ZAKÁZKA.xlsm"
   
    For Each CC In WordDoc.ContentControls
        If RangeExists(CC.Title) Then
            CC.Range.Text = Range(CC.Title).Text
        End If
    Next


End Sub

---

All of above is untested.

Quote:

---

Originally Posted by Cubajz

So far I managed with my code to populate only one specified Content Control field from Excel named range (see below) - otherwise code works fine.
Obviously I have many more Content Control´s fields in document and I would like code to go through ALL Content control fields

---

Without wanting to place too fine a point on it, Content Controls are not fields - the two are entirely different.

Thanks for this clarification Macropod, you are of course right.:yes

I eventualy got and idea for code bellow which works fine, however I am unable to update Content Controls in Header or Footer.

Code:

---


Sub Populate_ContentControls_in_embeded_document()

Dim WordApp As Object
Dim WordDoc As Object
Dim CC As ContentControl
Dim CCName As String

Set WordApp = GetObject(, "Word.Application")
   
With WordApp
Set WordDoc = .Documents("Dokument v " & ActiveWorkbook.Name) 'example of embeded document name: "Dokument v AAA_ZAKÁZKA.xlsm"
End With


'Go through all CC in embeded Word document and if there is some with title that is the same as excel named range - then populate CC with text from excel named range
For Each CC In WordDoc.ContentControls
    CCName = CC.Title
    If CC.Title = ActiveWorkbook.Names(CCName).Name Then
    CC.Range.Text = Range(CCName).Text
    End If

Next

End Sub

---

I tried this for header but it doesnt work:

Code:

---

For Each CC In WordDoc.Sections(1).headers(wdHeaderFooterPrimary).Range.ContentControls
    CCName = CC.Title
    If CC.Title = ActiveWorkbook.Names(CCName).Name Then
        CC.Range.Text = Range(CCName).Text
    End If
Next

---

Thanks again for any replies.:yes