Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 11-19-2012, 11:41 AM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default Creating a plain text content control for every instance of a word or phrase

Like the title says...

I have managed to make a script that on command creates a content control that maps to a custom XML part. This way I can copy and paste that content control various places in the document and changing the values in one automatically updates the others.

However, I would like to create a way of automatically binding all instances of a string into a content control mapped to the custom XML part. Basically like a find and replace, except instead of replacing the text it just places it in a simple text CC.

Bonus points for the same thing with the date picker CC.

Any help would be really appreciated. My VBA skills are shaky and the first part took me a long time without asking for help.
Reply With Quote
  #2  
Old 11-19-2012, 12:20 PM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

HTML Code:
Sub AddContentControlAndMapToLocalXML()
Dim oCC As Word.ContentControl
Dim oCustomPart As Office.CustomXMLPart
Dim xmlPart As String
Dim doc As Word.Document
Set doc = ActiveDocument
Dim oRng As Word.Range
Dim strToFind As String
ClearXMLParts
xmlPart = "<?xml version='1.0' encoding='utf-8'?><Root><Item></Item></Root>"
Set oCustomPart = doc.CustomXMLParts.Add(xmlPart)
strToFind = "Text to find"
Set oRng = ActiveDocument.Range
  With oRng.Find
    .Text = strToFind
    .Wrap = wdFindStop
    While .Execute
      Set oCC = doc.ContentControls.Add(wdContentControlText, oRng)
      oCC.XMLMapping.SetMapping "/Root/Item[1]", , oCustomPart
      oCC.Range.Text = strToFind
      oRng.Collapse wdCollapseEnd
      Do While oRng.InRange(oCC.Range)
        oRng.Move wdCharacter, 1
      Loop
    Wend
  End With
End Sub
'Run ClearXMLParts prior to testing these examples.
Sub ClearXMLParts()
Dim i As Long
'MsgBox ActiveDocument.CustomXMLParts.Count
For i = ActiveDocument.CustomXMLParts.Count To 4 Step -1
  ActiveDocument.CustomXMLParts(i).Delete
Next i
End Sub
 
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #3  
Old 11-19-2012, 01:55 PM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

Thanks gmaxey
I took your code and tried to modify it to find the title of a CC whose content matches the search text first and then use that title instead of master, but I am getting an error on the line marked with an *.

HTML Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Dim oCC As ContentControl
Dim i As Long
Dim oCCTitle As String
Set oRng = ActiveDocument.Range
  With oRng.Find
    'Finds the title of the existing CC with matching text
    .Text = "Text to find"
    While .Execute
        For i = 1 To ActiveDocument.ContentControls.Count
            If ActiveDocument.ContentControls(i).Range.Text = "Text to find" Then
            'object required error on following line
*            Set oCCTitle = ActiveDocument.ContentControls(i).Title
            End If
        Next i
  End With
  With oRng.Find
    'Assumes that you already have a mapped CC in the document titled "Master"
    .Text = "Text to find"
    While .Execute
      If Not oRng.InRange(ActiveDocument.SelectContentControlsByTitle(oCCTitle).Item(1).Range) Then
      Set oCC = ActiveDocument.ContentControls.Add(wdContentControlText, oRng)
      oCC.XMLMapping.SetMapping (ActiveDocument.SelectContentControlsByTitle(oCCTitle).Item(1).XMLMapping.xPath)
      oRng.Collapse wdCollapseEnd
      End If
    Wend
  End With
End Sub
Your updated code seems to produce an error
Reply With Quote
  #4  
Old 11-19-2012, 02:15 PM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

ActiveDocument.ContentControls(i).Title would return a string (i.e., the title of a content control)

Set oCCTitle = 'Requires an object.
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #5  
Old 11-19-2012, 02:28 PM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

If it is returning a string and I want to store that string in a variable that I have declared as a String, what am I doing wrong here?

HTML Code:
Dim oCCTitle As String
...
     Set oCCTitle = ActiveDocument.ContentControls(i).Title
Reply With Quote
  #6  
Old 11-19-2012, 03:34 PM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

Remove the "Set" statement.

HTML Code:
oCCTitle = ActiveDocument.ContentControls(i).Title
HTML Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim strCCTitle As String
Dim oCC As ContentControl
Set oCC = ActiveDocument.ContentControls.Add
oCC.Title = "This is my title"
strCCTitle = oCC.Title
MsgBox strCCTitle
End Sub
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #7  
Old 11-20-2012, 05:08 AM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

Ah! thank you. I'll give that a try
Reply With Quote
  #8  
Old 11-20-2012, 06:49 AM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

Ok, I took what gmaxey provided and them I added the InputBox for the query and then some other controls. It works, but when the function would create multiple CCs all mapped together (like if you were to query for text that is repeated several times in a document), the script returns an error, at the line below with all the **** in the line.

*** Set oCC = ActiveDocument.ContentControls.Add(wdContentContro lText, oRng)

"Run-time error '4198':
Command failed"

It still does what I want it to do, so if I can clear this error then it will be perfect.

HTML Code:
Sub CreateCCForMatchedText()
'Much thanks to Greg Maxey for doing the hard part
Dim oRng As Word.Range
Dim oQuery As String
Dim oCC As ContentControl
Dim i As Long
Dim oCCTitle As String
Dim oCCTitleAssignment As String
Dim oCancelOperation As Integer
Dim oSameTitle As Boolean

Set oRng = ActiveDocument.Range
oSameTitle = False
oQuery = InputBox("Enter text to bind to Content Controls", "Find and Bind")
  With oRng.Find
    .Text = oQuery
    While .Execute
        'Find the Title for any CC that whose contents match the query
        For i = 1 To ActiveDocument.ContentControls.Count
            If ActiveDocument.ContentControls(i).Range.Text = oQuery Then
            oCCTitle = ActiveDocument.ContentControls(i).Title
            End If
        Next i
        Do While oCCTitle = ""
        'Loop to ensure that each CC created will have a title if none exists
            oCCTitleAssignment = InputBox("You Must Enter the Title for the Content Controls to be added", "Enter Title", "")
            If oCCTitleAssignment = "" Then
                oCancelOperation = MsgBox("You didn't enter a title for this Content Control, do you want to cancel the operation?", vbYesNo, "error")
                If oCancelOperation = vbYes Then
                    Exit Sub
                End If
                'Make sure that the title isn't already taken by a different CC
                For i = 1 To ActiveDocument.ContentControls.Count
                    If ActiveDocument.ContentControls(i).Title = oCCTitle And ActiveDocument.ContentControls(i).Range.Text <> oQuery Then
                        oSameTitle = True
                    End If
                Next i
                If oSameTitle = True Then
                    MsgBox ("This Title is already used for another Content Control, Please Choose Another")
                End If
            End If
        Loop
        'Then map the CC to the customXMLpart and assign the title to the CC
        If Not oRng.InRange(ActiveDocument.SelectContentControlsByTitle(oCCTitle).Item(1).Range) Then
 ***  Set oCC = ActiveDocument.ContentControls.Add(wdContentControlText, oRng)   ******
        oCC.XMLMapping.SetMapping (ActiveDocument.SelectContentControlsByTitle(oCCTitle).Item(1).XMLMapping.xPath)
        oCC.Title = oCCTitle
        oRng.Collapse wdCollapseEnd
        End If
    Wend
  End With
End Sub
Reply With Quote
  #9  
Old 11-20-2012, 08:26 AM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

Ok an update... Again thank you to gmaxey for all his help.

I had to clear a few errors from the code but I still don't know how to fix the one error that keeps cropping up.
It has to do with the fact that if there are more than one CC in the document with the same title already, the following statements will only except the first, and then error on the second (or so it seems). How can I write the following exception differently so that it excludes all existing CCs?

HTML Code:
        If Not oRng.InRange(ActiveDocument.SelectContentControlsByTitle(oCCTitle).Item(1).Range) Then
            'The following line gives me a command failed error when there are more than one existing CCs
            'with the same title. Sometimes the error is
            Set oCC = ActiveDocument.ContentControls.Add(wdContentControlText, oRng)
            oCC.XMLMapping.SetMapping (ActiveDocument.SelectContentControlsByTitle(oCCTitle).Item(1).XMLMapping.xPath)
            oCC.Title = oCCTitle
            oRng.Collapse wdCollapseEnd
        End If
Reply With Quote
  #10  
Old 11-20-2012, 09:13 AM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

I'm having a hard time keeping up with you. It seems that you are trying to do a couple of things inside the With.Find ... While .Execute.

Seems to me that you should deal with existing CCs first then do the find and deal with plain text that you want to create a CC and map.

HTML Code:
Sub AddContentControlAndMapToLocalXML()
Dim oCC As Word.ContentControl
Dim oCustomPart As Office.CustomXMLPart
Dim xmlPart As String
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim strQuery As String
Dim lngIndex As Long
Dim strCC_Title As String
Dim bTitled As Boolean
  Set oDoc = ActiveDocument
  bTitled = False
  ClearXMLParts
  xmlPart = "<?xml version='1.0' encoding='utf-8'?><Root><Item></Item></Root>"
  Set oCustomPart = oDoc.CustomXMLParts.Add(xmlPart)
  strQuery = InputBox("Enter text to bind to Content Controls", "Find and Bind")
  'Deal with existing CCs
  'Find the title for any existing CC who's contents match the querry.
  For lngIndex = 1 To oDoc.ContentControls.Count
    Set oCC = oDoc.ContentControls(lngIndex)
    If oCC.Range.Text = strQuery Then
      'Define title.
      If Not bTitled Then
        'Is CC titled?
        strCC_Title = ActiveDocument.ContentControls(lngIndex).Title
        If Len(strCC_Title) > 0 Then
          bTitled = True
        Else
          Do
            strCC_Title = InputBox("Enter a CC title")
            If StrPtr(strCC_Title) = 0 Then GoTo lbl_Exit 'User canceled
          Loop Until strCC_Title <> ""
          oCC.Title = strCC_Title
        End If
      End If
      'Is the CC mapped?
      If Not oCC.XMLMapping.IsMapped Then
        'Map it.
        oCC.XMLMapping.SetMapping "/Root/Item[1]", , oCustomPart
      End If
    End If
  Next lngIndex
  'Find text, add and map CCs.
  Set oRng = ActiveDocument.Range
  If Len(strCC_Title) = 0 Then
    Do
      strCC_Title = InputBox("Enter a CC title")
      If StrPtr(strCC_Title) = 0 Then GoTo lbl_Exit 'User canceled
    Loop Until strCC_Title <> ""
  End If
  With oRng.Find
    .Text = strQuery
    .Wrap = wdFindStop
    While .Execute
      Set oCC = oDoc.ContentControls.Add(wdContentControlText, oRng)
      oCC.XMLMapping.SetMapping "/Root/Item[1]", , oCustomPart
      oCC.Range.Text = strQuery
      oCC.Title = strCC_Title
      oRng.Collapse wdCollapseEnd
      Do While oRng.InRange(oCC.Range)
        oRng.Move wdCharacter, 1
      Loop
    Wend
  End With
lbl_Exit:
  Exit Sub
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
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #11  
Old 11-20-2012, 09:53 AM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

Couple of other things you might consider.

1) Use calls to functions to do standard things like validate a unique title:

HTML Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim strTitle As String
strTitle = "Name"
'Is this a unique titled?  Check with function
If fcn_IsTitleUnique(strTitle) Then
  Debug.Print "Yep it is."
Else
  Debug.Print "Nope its not."
End If
End Sub
Function fcn_IsTitleUnique(ByRef strTitlePassed As String) As Boolean
Dim oCol As New Collection
Dim oCC As ContentControl
fcn_IsTitleUnique = True
For Each oCC In ActiveDocument.ContentControls
  oCol.Add oCC.Title, oCC.Title
Next oCC
  On Error Resume Next
  oCol.Add strTitlePassed, strTitlePassed
  If Err.Number = 0 Then fcn_IsTitleUnique = True
  On Error GoTo 0
lbl_Exit:
  Exit Function
End Function
2) You can simplify InputBox code using StrPtr. This lets you determine between user pressing "Cancel" or not making an entry:

HTML Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim strDemo As String
Dim bVillageIdiotNeedsHelp As Boolean
bVillageIdiotNeedsHelp = False
Do
  If Not bVillageIdiotNeedsHelp Then
    strDemo = InputBox("Enter your name")
    bVillageIdiotNeedsHelp = True
  Else
    strDemo = InputBox("You have an name even if it is Village Idiot." & vbCr + vbCr _
                      & "Please enter your name!")
  End If
  'User cancels.
  If StrPtr(strDemo) = 0 Then GoTo lbl_Exit
Loop Until strDemo <> ""
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #12  
Old 11-20-2012, 10:21 AM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

It seems like the code in your post (at 12:13) overcomes the error I was encountering before, but it also maps all content controls to the same XML object/address/Id (I'm not sure what you call it). So the content of any existing CCs in the document is changed to the query string.

The big question is how do you exclude the existing CCs from the mapping operation so that you can have different sets of CCs for different reoccurring words or phrases?

I'm sorry that I don't yet understand the details of your code, I'm not to good at VBA and even worse when I step outside of Excel
Reply With Quote
  #13  
Old 11-20-2012, 01:13 PM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

That is not what happens here. I am going back to you original post and you need to stop moving the goal post after the start of the game.

1. You want to find some text and put any found text into a CC mapped to an XML node. OK. In a new document type: test test test test test test

Run the code. You should get a prompt to enter the text to find (enter test) and a prompt to enter a titled. Do so. The result should be 6 CCs mapped to an XML Node.

2. With another new document. Create a CC name it "Test" and make its contents = test. Add another CC. Name it something other than "Test" and make its contents something else (e.g., some other text). Then type test test test test test.

Run the code. When prompted for search term enter "test" You won't get prompted for the title because a CC already exists that is titled "Test." The other CC named something else should not be affected and your should have six new CC titlted "Test" and mapped to the same node.

If you are wanting to have multiple groups of mapped CCs then you will have to have multiple nodes in your XML part. Right now there is only one node.
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #14  
Old 11-20-2012, 01:43 PM
gmaxey gmaxey is offline Windows 7 32bit Office 2010 (Version 14.0)
Former Word MVP
 
Join Date: May 2010
Location: Marble, NC
Posts: 332
gmaxey is on a distinguished road
Default

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
 
__________________
Greg Maxey
Please visit my web site at http://gregmaxey.mvps.org
Reply With Quote
  #15  
Old 11-20-2012, 01:44 PM
RobsterCraw RobsterCraw is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Nov 2012
Posts: 11
RobsterCraw is on a distinguished road
Default

I think I am getting closer to a full solution, but I'm really just learning as I go. You are right though. I figured out that the issue was the fact that I forgot that I needed to create new nodes for new unique CC titles. I'm trying to incorporate a function that validate whether a child node exists that matches the CCTitle and if not will create new node before the CC is mapped to it. However, with my knowledge level this will take me a little while, but if I can get it clean and working, then I think I'm set.
Your help was invaluable
Reply With Quote
Reply

Tags
content control, find & replace, xml
Please reply to this thread with any new information or opinions.

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do you set rich text in a content control Testor Word VBA 4 07-08-2012 07:55 AM
Word2010 check boxes and plain text content control boxes in same table fcsungard Word 5 06-01-2012 01:16 AM
Rich Text Content Control - Allow User Formatting keithacochrane Word 1 05-28-2012 05:06 PM
Rich text/Plain text Content Controls in Template michael.fisher5 Word 8 04-26-2012 02:34 PM
Templates: automatic text generation from Rich Text content control Chickenmunga Word 0 10-01-2008 11:16 AM


All times are GMT -7. The time now is 02:45 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft