|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
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. |
#2
|
|||
|
|||
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 |
#3
|
|||
|
|||
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 |
#4
|
|||
|
|||
ActiveDocument.ContentControls(i).Title would return a string (i.e., the title of a content control)
Set oCCTitle = 'Requires an object. |
#5
|
|||
|
|||
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 |
#6
|
|||
|
|||
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 |
#7
|
|||
|
|||
Ah! thank you. I'll give that a try
|
#8
|
|||
|
|||
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 |
#9
|
|||
|
|||
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 |
#10
|
|||
|
|||
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 |
#11
|
|||
|
|||
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 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 |
#12
|
|||
|
|||
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 |
#13
|
|||
|
|||
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. |
#14
|
|||
|
|||
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 |
#15
|
|||
|
|||
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 |
Tags |
content control, find & replace, xml |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Rich text/Plain text Content Controls in Template | michael.fisher5 | Word | 9 | 11-19-2014 06:36 AM |
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 |
Templates: automatic text generation from Rich Text content control | Chickenmunga | Word | 0 | 10-01-2008 11:16 AM |