View Single Post
 
Old 08-18-2022, 01:53 PM
DMSI DMSI is offline Windows 10 Office 2016
Novice
 
Join Date: Aug 2022
Posts: 4
DMSI is on a distinguished road
Default

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.
Reply With Quote