Find and Replace Question

[Fuzzhead]

I have the following macro that finds the word ‘NOTE’ in the document and
creates a Note Box. How do I get the text that follows the word NOTE and move
it into my Note Box once it is created?

Example of what I have:
NOTE: A does not have Open or Close indication when operated from B.

What I would like it to look like:

NOTE: A does not have Open or Close indication when operated from B
(Inside my Box)

Sub ConvertNotes()
On Error GoTo Endthis

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "NOTE:"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
End With


Do While Selection.Find.Execute(Replace:=wdReplaceOne)
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=1, NumColumns:= _
1, DefaultTableBehavior:=wdWord9TableBehavior,
AutoFitBehavior:=wdAutoFitFixed
Selection.Tables(1).Rows.SetLeftIndent LeftIndent:=44,
RulerStyle:=wdAdjustNone
Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=423,
RulerStyle:=wdAdjustNone
If Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
Else
Selection.Font.Underline = wdUnderlineNone
End If
Selection.TypeText Text:="NOTE"
If Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
Else
Selection.Font.Underline = wdUnderlineNone
End If
Selection.TypeText Text:=":"
Selection.TypeText Text:=" "
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0.63)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(-0.63)
End With

Loop

Endthis:

End Sub

 

[Jonathan West]

Hi Fuzzhead,

I suspect that you are making life unnecessarily difficult for yourself.
instead of going to the trouble of putting your text inside a 1-row,
1-column table and putting a border round it, why not simply format the
paragraph with a border round it? That way, you don't need to move any text
at all, just reformat it.

But if you really want the table, then a better approach is to convert the
note paragraph to the table rather than insert a table and move the
paragraph, like this

Sub ConvertNotes()
On Error GoTo Endthis

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "NOTE:"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
End With


Do While Selection.Find.Execute
Selection.Paragraphs(1).Range.Select
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumRows:=1,
numColumns:=1
Selection.Tables(1).Rows.SetLeftIndent LeftIndent:=44,
RulerStyle:=wdAdjustNone
Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=423,
RulerStyle:=wdAdjustNone
If Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
Else
Selection.Font.Underline = wdUnderlineNone
End If
If Selection.Font.Underline = wdUnderlineNone Then
Selection.Font.Underline = wdUnderlineSingle
Else
Selection.Font.Underline = wdUnderlineNone
End If
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0.63)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(-0.63)
End With
Selection.Collapse Direction:=wdCollapseEnd
Loop

Endthis:

End Sub


--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org

 

[Fuzzhead]

Hi Jonathan,

This worked great. Thanks for your help. I do have one question though. The
spacing between the word 'NOTE:' and the next word is not the same. I want
them all to be 4 spaces. I tried the following but the word 'Note" is
underlined and when I replaced it the underline also includes the 4 spaces.
How do I keep just the word 'Note" underlined?

..Text = "NOTE:^w"
..Replacement.Text = "NOTE: "

 

[Jonathan West]

Hi Jonathan,

This worked great. Thanks for your help. I do have one question though.
The
spacing between the word 'NOTE:' and the next word is not the same. I want
them all to be 4 spaces. I tried the following but the word 'Note" is
underlined and when I replaced it the underline also includes the 4
spaces.
How do I keep just the word 'Note" underlined?

.Text = "NOTE:^w"
.Replacement.Text = "NOTE: "

OK, couple of minor tweaks to the code. Try this

Sub ConvertNotes()
On Error GoTo Endthis

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "NOTE:^w"
.Replacement.Text = "NOTE: "
.Format = False
.Forward = True
.Wrap = wdFindStop
End With


Do While Selection.Find.Execute(Replace:=wdReplaceOne)
Selection.Font.Underline = wdUnderlineNone
Selection.Words(1).Font.Underline = wdUnderlineSingle
Selection.Paragraphs(1).Range.Select
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumRows:=1,
numColumns:=1
Selection.Tables(1).Rows.SetLeftIndent LeftIndent:=44,
RulerStyle:=wdAdjustNone
Selection.Tables(1).Columns(1).SetWidth ColumnWidth:=423,
RulerStyle:=wdAdjustNone
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0.63)
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
End With
With Selection.ParagraphFormat
.SpaceBeforeAuto = False
.SpaceAfterAuto = False
.FirstLineIndent = InchesToPoints(-0.63)
End With
Selection.Collapse Direction:=wdCollapseEnd
Loop

Endthis:

End Sub