hey so I figured out a solution that worked for me. Basically what I did was combine both the codes I posted below, first my macro scans the doc and does a word replace to put the word in double brackets, then applies the content control and then runs the word replace again to remove the double brackets.
Here is a sample of what I used incase anyone needs to solve for a similar for something similar with lots of words that need to have content controls added in longer word documents.
Sub Add_Content_Controls()
'This runs a series of macros to add DocumentVariables within a Word document
Call Content_Control_AddBrackets
Call AddAllTagsDouble
Call Content_Control_RemoveDoubleBracket
MsgBox "Content Controls Added"
End Sub
Function AddAllTagsDouble()
'
' Runs add content control in entire document
'
'
For i = 0 To ActiveDocument.Words.Count
Selection.EscapeKey
Call AddTagsDouble
Next
End Function
Function AddTagsDouble()
'
' Adds Conent Control to objects within a double bracket
'
'
Dim myRange
Set myRange = Application.ActiveDocument.Content
With Selection.Find
.ClearFormatting
.Text = "(\[{2})(*)(\]{2})"
.Execute Forward:=True
.MatchWildcards = True
End With
nobrackets = Replace(Replace(Selection.Text, "[", ""), "]", "")
If Selection.Find.Found = True Then
Selection.Range.ContentControls.Add (wdContentControlText)
Selection.ParentContentControl.Title = nobrackets
Selection.ParentContentControl.Tag = "DocumentVariable"
End If
End Function
Sub Content_Control_AddBracket()
' Adds brackets to all text listed in Variable list
Dim wd As Word.Application
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim rng2 As Excel.Range
Dim cl As Object
Dim Counter As Integer
StatusBar = "Scanning document for DocumentVariables, please wait ="
'If ActiveDocument.TrackRevisions = False Then
' ActiveDocument.TrackRevisions = True
'End If
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open("YOUR EXCEL DOCUMENT") '## Modify as needed
Set ws = wb.Sheets("Custom") '## Modify as needed
Set rng2 = ws.Range("A1", ws.Range("A1").End(xlDown))
For Each cl In rng2
Call FindReplace(cl.Value, cl.Offset(0, 1).Value)
Next
wb.Close
xl.Quit
End Sub
Sub Content_Control_RemoveDoubleBracket()
Dim wd As Word.Application
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim rng2 As Excel.Range
Dim cl As Object
Dim Counter As Integer
StatusBar = "Cleaning DocumentVariables, please wait ="
'If ActiveDocument.TrackRevisions = False Then
' ActiveDocument.TrackRevisions = True
'End If
Set xl = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Open("YOUR EXCEL DOCUMENT") '## Modify as needed
Set ws = wb.Sheets("Custom") '## Modify as needed
Set rng2 = ws.Range("A1", ws.Range("A1").End(xlDown))
For Each cl In rng2
Call FindReplace(cl.Value, cl.Offset(0, 1).Value)
Next
wb.Close
xl.Quit
End Sub
Function FindReplace(findText, replaceText) As Integer
'
With Selection.Find
.Text = findText
.Replacement.Text = replaceText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
bReplaced = Selection.Find.Execute(Replace:=wdReplaceAll)
If bReplaced = True Then FindReplace = 1 Else FindReplace = 0
End Function
There might be a better more efficient way to do this, but it worked for what I needed.
thanks all.
|