Macro to find a marker, format the line, delete the marker

Hi all,

My Situation:

I regularly get plain text documents (*.txt), that are completely
unformatted. Now a macro should do the following for the entire
document:

1. Find all lines starting with " Titel: " (5 x Space, "Titel", 1
x Space)
2. Format the entire line
3. Delete the marke " Titel: " at the beginning of the line.

I managed to write the following code (that even works ;-) :

Sub HighlightTitel()

Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "Titel: "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With

Do While Selection.Find.Execute = True
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.Name = "Tahoma"
Selection.Font.Size = 16
Selection.Font.Bold = True
Selection.Font.Italic = True
Selection.MoveRight Unit:=wdCharacter, Count:=1
Loop

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

With Selection.Find
.Text = " Titel: "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Selection.HomeKey Unit:=wdStory

End Sub

This seems to be much more code than actually needed, i.e. I am sure
that several lines are redundant.

So I would appreciate any hint for improvement. I am for example very
interessted to get rid of the Selection Object.

Thanks a lot,

Marcus.

Danke, Marcus.

Helmut
Wed Dec 14 22:08:58 CST 2005

Hi Marcus,

if you are talking about paragraphs, not lines, then:

Sub test01()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = " Titel: "
.Replacement.Text = ""
While .Execute(Replace:=wdReplaceOne)
With rDcm.Paragraphs(1).Range
.Font.Name = "Tahoma"
.Font.Size = 16
End With
Wend
End With
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

Marcus
Thu Dec 15 13:00:45 CST 2005

On Thu, 15 Dec 2005 05:08:58 +0100, Helmut Weber
<nbhymsjxdgcn@mailinator.com> wrote:

>Hi Marcus,
>
>if you are talking about paragraphs, not lines, then:
>
>Sub test01()
>Dim rDcm As Range
>Set rDcm = ActiveDocument.Range
>With rDcm.Find
> .Text = " Titel: "
> .Replacement.Text = ""
> While .Execute(Replace:=wdReplaceOne)
> With rDcm.Paragraphs(1).Range
> .Font.Name = "Tahoma"
> .Font.Size = 16
> End With
> Wend
>End With
>End Sub

Hi Helmut,

works great. And it's so simple.

Thanks a lot, Marcus.