Microsoft Office Forums - View Single Post - [Solved] Creating a plain text content control for every instance of a word or phrase

gmaxey · 11-20-2012, 02:43 PM

Lets try to simplify this a little. Add three CCs to a document. Named "Name", "Address", and "Age".

Copy and pastes the three CCs to various other places in the document. So now you have two or three CCs named "Name" and four or five named "Address" and so on.

You want to map all the CCs named "Name" to one XML node, all named "Address" to another XML node and so on.

HTML Code:

Option Explicit
Sub XXXAddContentControlAndMapToLocalXML()
Dim oCC As Word.ContentControl
Dim oCustomPart As Office.CustomXMLPart
Dim xmlPart As String
Dim oDoc As Word.Document
Dim lngIndex As Long
Dim bTitled As Boolean
  Set oDoc = ActiveDocument
  bTitled = False
  ClearXMLParts
  'Create the basic XML Part
  xmlPart = "<?xml version='1.0' encoding='utf-8'?><Root_Node><CCMapping_Node></CCMapping_Node></Root_Node>"
  Set oCustomPart = oDoc.CustomXMLParts.Add(xmlPart)
  'Add two more "CCMapping_Node" nodes.
  For lngIndex = 1 To 2
    oCustomPart.AddNode oCustomPart.SelectSingleNode("/Root_Node"), "CCMapping_Node"
  Next lngIndex
  For lngIndex = 1 To oDoc.ContentControls.Count
    Set oCC = oDoc.ContentControls(lngIndex)
    Select Case oCC.Title
      Case "Name"
        'Map all CCs titled "Name" to CCMapping_Node node 1.
        oCC.XMLMapping.SetMapping "/Root_Node/CCMapping_Node[1]", , oCustomPart
      Case "Address"
        'Map all CCs titled "Address" to CCMapping_Node node 2.
        oCC.XMLMapping.SetMapping "/Root_Node/CCMapping_Node[2]", , oCustomPart
      Case "Age"
        'Map all CCs titled "Age" to CCMapping_Node node 3.
        oCC.XMLMapping.SetMapping "/Root_Node/CCMapping_Node[3]", , oCustomPart
    End Select
  Next lngIndex
End Sub
'Run ClearXMLParts prior to testing these examples.
Sub ClearXMLParts()
Dim lngIndex As Long
'MsgBox ActiveDocument.CustomXMLParts.Count
For lngIndex = ActiveDocument.CustomXMLParts.Count To 4 Step -1
  ActiveDocument.CustomXMLParts(lngIndex).Delete
Next lngIndex
End Sub