find with wild cards and add into CC

sylvio · #1 09-03-2017, 10:52 PM

Good day

I cannot understand what is the problem with the code below.
I am trying to put every line of the text in separate content controls:

<paragraph mark> just some text <paragraph mark>
<paragraph mark> another piece of some text <paragraph mark>
<paragraph mark> just some text <paragraph mark>

With wild card "[!^13]@some*^13" the code looks for complete string embraced by paragraph marks and puts it into CC, but somehow the code falls into endless loop. With Ctrl+Break I can see that the job is done, so in general the code is ok.
What is the point?

Code:

Sub Add_CC_w_Title()

Dim oCC As Word.ContentControl
Dim doc As Word.Document
Dim oRng As Range
Set doc = ActiveDocument
Set oRng = ActiveDocument.Range
    
    With oRng.Find
            .Text = "[!^13]@some*^13"
            .Wrap = wdFindContinue
            .MatchWildcards = True
            
            While .Execute
                'oRng.Font.Color = wdColorRed
                Set oCC = doc.ContentControls.Add(wdContentControlText, oRng)
                oCC.Title = "title"
            Wend
    End With

End Sub

macropod · #2 09-03-2017, 11:37 PM

Try:

Code:

Sub Add_CC_w_Title()
Dim oCC As Word.ContentControl
With ActiveDocument.Range
  With .Find
    .Text = "[!^13]@some*^13"
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    Set oCC = .ContentControls.Add(wdContentControlText, .Duplicate)
    oCC.Title = "title"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
End Sub

sylvio · #3 09-04-2017, 01:00 AM

Just perfect! Thank you.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
remove repeated words with " macro " or " wild cards " in texts with parentheses and commas	jocke321	Word VBA	2	12-10-2014 11:27 AM
Question about find and replace wild cards	catherineliang	Word	1	07-21-2014 09:42 PM
Wild card to highlight capitalised terms?	bertietheblue	Word	2	02-08-2013 04:44 PM
Printing on 3x5 cards	Jennifer Murphy	Word	0	08-05-2011 06:00 PM
Bingo Cards	office_mike	Excel	1	11-29-2008 10:17 PM